[Pkg] The Trunk: Morphic-dtl.325.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Feb 7 03:36:12 UTC 2010


David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.325.mcz

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

Name: Morphic-dtl.325
Author: dtl
Time: 6 February 2010, 10:32:29.805 pm
UUID: 357f1107-7d96-4b03-a972-6f1cc6b9287a
Ancestors: Morphic-dtl.324

Move StandardFileMenu from Morphic-FileList to Tools-Menus. StandardFileMenu is not Morphic specific.

=============== Diff against Morphic-dtl.324 ===============

Item was removed:
- ----- Method: StandardFileMenu class>>newFileFrom: (in category 'standard file operations') -----
- newFileFrom: aDirectory
- 
- 	^(self newFileMenu: aDirectory)
- 		startUpWithCaption: 'Select a File:' translated!

Item was removed:
- ----- Method: StandardFileMenu>>pattern: (in category 'private') -----
- pattern: aPattern
- 	" * for all files, or '*.cs' for changeSets, etc.  Just like fileLists"
- 
- 	pattern := {aPattern}!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileStreamFrom: (in category 'standard file operations') -----
- oldFileStreamFrom: aDirectory
- 
- 	| sfmResult fileStream |
- 	sfmResult := self oldFileFrom: aDirectory.
- 	sfmResult ifNil: [^nil].
- 	fileStream := sfmResult directory oldFileNamed: sfmResult name.
- 	[fileStream isNil] whileTrue:
- 		[sfmResult := self oldFileFrom: aDirectory.
- 		sfmResult ifNil: [^nil].
- 		fileStream := sfmResult directory oldFileNamed: sfmResult name].
- 	^fileStream
- !

Item was removed:
- ----- Method: StandardFileMenu>>menuSelectionsArray: (in category 'menu building') -----
- menuSelectionsArray: aDirectory
- "Answer a menu selections object corresponding to aDirectory.  The object is an array corresponding to each item, each element itself constituting a two-element array, the first element of which contains a selector to operate on and the second element of which contains the parameters for that selector."
- 
- 	|dirSize|
- 	dirSize := aDirectory pathParts size.
- 	^Array streamContents: [:s |
- 		canTypeFileName ifTrue:
- 			[s nextPut: (StandardFileMenuResult
- 				directory: aDirectory
- 				name: nil)].
- 		s nextPut: (StandardFileMenuResult
- 			directory: (FileDirectory root)
- 			name: '').
- 		aDirectory pathParts doWithIndex: 
- 			[:d :i | s nextPut: (StandardFileMenuResult
- 					directory: (self 
- 						advance: dirSize - i
- 						containingDirectoriesFrom: aDirectory)
- 					name: '')].
- 		aDirectory directoryNames do: 
- 			[:dn |  s nextPut: (StandardFileMenuResult
- 						directory: (FileDirectory on: (aDirectory fullNameFor: dn))
- 						name: '')].
- 		aDirectory fileNames do: 
- 			[:fn | pattern do: [:pat | (pat match: fn) ifTrue: [
- 					s nextPut: (StandardFileMenuResult
- 						directory: aDirectory
- 						name: fn)]]]]!

Item was removed:
- ----- Method: StandardFileMenu>>pathPartsString: (in category 'menu building') -----
- pathPartsString: aDirectory
- "Answer a string concatenating the path parts strings in aDirectory, each string followed by a cr."
- 
- 	^String streamContents:
- 		[:s | 
- 			s nextPutAll: '[]'; cr.
- 			aDirectory pathParts asArray doWithIndex: 
- 				[:part :i |
- 					s next: i put: $ .
- 					s nextPutAll: part withBlanksTrimmed; cr]]!

Item was removed:
- ----- Method: StandardFileMenu class>>newFileMenu: (in category 'instance creation') -----
- newFileMenu: aDirectory
- 	Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
- 	^ super new newFileFrom: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu>>getTypedFileName: (in category 'basic control sequences') -----
- getTypedFileName: aResult
- 
- 	| name |
- 	name := UIManager default 
- 		request: 'Enter a new file name' 
- 		initialAnswer: ''.
- 	name = '' ifTrue: [^self startUpWithCaption: 'Select a File:' translated].
- 	name := aResult directory fullNameFor: name.
- 	^ StandardFileMenuResult
- 			directory: (FileDirectory forFileName: name)
- 			name: (FileDirectory localNameFor: name)
- !

Item was removed:
- ----- Method: StandardFileMenu>>newFileFrom: (in category 'private') -----
- newFileFrom: aDirectory
- 
- 	canTypeFileName := true.
- 	^self makeFileMenuFor: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu class>>newFileMenu:withPattern: (in category 'instance creation') -----
- newFileMenu: aDirectory withPattern: aPattern
- 	Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
- 	^ super new newFileFrom: aDirectory withPattern: aPattern!

Item was removed:
- SelectionMenu subclass: #StandardFileMenu
- 	instanceVariableNames: 'canTypeFileName pattern'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Morphic-FileList'!
- 
- !StandardFileMenu commentStamp: 'mp 8/15/2005 18:44' prior: 0!
- I represent a SelectionMenu which operates like a modal dialog for selecting files, somewhat similar to the StandardFile dialogs in MacOS and Java Swing.
- 
- Try for example, the following:
- 
- 	StandardFileMenu oldFile inspect
- 
- 	StandardFileMenu oldFileStream inspect
- 
- 	StandardFileMenu newFile inspect
- 
- 	StandardFileMenu newFileStream inspect
- 	
- 	(StandardFileMenu oldFileMenu: FileDirectory default withPattern: '*') startUpWithCaption: 'Select a file:'
- 	
- 	(StandardFileMenu oldFileMenu: (FileDirectory default) withPatternList: {'*.txt'. '*.changes'}) startUpWithCaption: 'Select a file:'
- !

Item was removed:
- ----- Method: StandardFileMenu>>newFileFrom:withPatternList: (in category 'private') -----
- newFileFrom: aDirectory withPatternList: aPatternList
- 
- 	canTypeFileName := true.
- 	pattern := aPatternList.
- 	^self makeFileMenuFor: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu>>menuLabelsString: (in category 'menu building') -----
- menuLabelsString: aDirectory
- "Answer a menu labels object corresponding to aDirectory"
- 
- 	^ String streamContents: 
- 		[:s | 
- 			canTypeFileName ifTrue: 
- 				[s nextPutAll: 'Enter File Name...'; cr].
- 			s nextPutAll: (self pathPartsString: aDirectory).
- 			s nextPutAll: (self directoryNamesString: aDirectory).
- 			s nextPutAll: (self fileNamesString: aDirectory).
- 			s skip: -1]!

Item was removed:
- ----- Method: StandardFileMenu>>patternList: (in category 'private') -----
- patternList: aPatternList
- 
- 	pattern := aPatternList!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileMenu:withPattern: (in category 'instance creation') -----
- oldFileMenu: aDirectory withPattern: aPattern
- 
- 	Smalltalk isMorphic ifFalse: [^PluggableFileList oldFileMenu: aDirectory].
- 	^super new oldFileFrom: aDirectory withPattern: aPattern!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFile (in category 'standard file operations') -----
- oldFile
- 
- 	^self oldFileFrom: (FileDirectory default)!

Item was removed:
- ----- Method: StandardFileMenu>>computeLabelParagraph (in category 'private') -----
- computeLabelParagraph
- 	"Answer a Paragraph containing this menu's labels, one per line and centered."
- 
- 	^ Paragraph withText: labelString asText style: (MenuStyle leftFlush)!

Item was removed:
- ----- Method: StandardFileMenu>>directoryNamesString: (in category 'menu building') -----
- directoryNamesString: aDirectory
- "Answer a string concatenating the directory name strings in aDirectory, each string followed by a '[...]' indicator, and followed by a cr."
- 
- 	^ String streamContents:
- 		[:s | aDirectory directoryNames do: 
- 				[:dn | s nextPutAll: dn withBlanksTrimmed , ' [...]'; cr]]
- 
- !

Item was removed:
- ----- Method: StandardFileMenu class>>newFile (in category 'standard file operations') -----
- newFile
- 
- 	^self newFileFrom: (FileDirectory default)!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileFrom: (in category 'standard file operations') -----
- oldFileFrom: aDirectory
- 
- 	^(self oldFileMenu: aDirectory)
- 		startUpWithCaption: 'Select a File:' translated!

Item was removed:
- ----- Method: StandardFileMenu class>>newFileStreamFrom: (in category 'standard file operations') -----
- newFileStreamFrom: aDirectory
- 
- 	| sfmResult fileStream |
- 	sfmResult := self newFileFrom: aDirectory.
- 	sfmResult ifNil: [^nil].
- 	fileStream := sfmResult directory newFileNamed: sfmResult name.
- 	[fileStream isNil] whileTrue:
- 		[sfmResult := self newFileFrom: aDirectory.
- 		sfmResult ifNil: [^nil].
- 		fileStream := sfmResult directory newFileNamed: sfmResult name].
- 	^fileStream
- !

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileFrom:withPattern: (in category 'standard file operations') -----
- oldFileFrom: aDirectory withPattern: aPattern
- "
- Select an existing file from a selection conforming to aPattern.
- "
- 	^(self oldFileMenu: aDirectory withPattern: aPattern)
- 		startUpWithCaption: 'Select a File:' translated!

Item was removed:
- ----- Method: StandardFileMenu>>newFileFrom:withPattern: (in category 'private') -----
- newFileFrom: aDirectory withPattern: aPattern
- 
- 	canTypeFileName := true.
- 	pattern := {aPattern}.
- 	^self makeFileMenuFor: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileMenu: (in category 'instance creation') -----
- oldFileMenu: aDirectory
- 	Smalltalk isMorphic ifFalse: [^ PluggableFileList oldFileMenu: aDirectory].
- 	^ super new oldFileFrom: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu>>oldFileFrom: (in category 'private') -----
- oldFileFrom: aDirectory
- 
- 	canTypeFileName := false.
- 	^self makeFileMenuFor: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu>>oldFileFrom:withPattern: (in category 'private') -----
- oldFileFrom: aDirectory withPattern: aPattern
- 
- 	canTypeFileName := false.
- 	pattern := {aPattern}.
- 	^self makeFileMenuFor: aDirectory!

Item was removed:
- ----- Method: StandardFileMenu>>fileNamesString: (in category 'menu building') -----
- fileNamesString: aDirectory
- "Answer a string concatenating the file name strings in aDirectory, each string followed by a cr."
- 
- 	^String streamContents:
- 		[:s | 
- 			aDirectory fileNames do: 
- 				[:fn |
- 					pattern do:[:each | (each match: fn) ifTrue: [
- 						s nextPutAll: fn withBlanksTrimmed; cr]]]]
- 		!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileStream (in category 'standard file operations') -----
- oldFileStream
- 
- 	^self oldFileStreamFrom: (FileDirectory default)
- !

Item was removed:
- ----- Method: StandardFileMenu>>advance:containingDirectoriesFrom: (in category 'private') -----
- advance: anInteger containingDirectoriesFrom: aDirectory
- 
- 	| theDirectory |
- 	theDirectory := aDirectory.
- 	1 to: anInteger do: [:i | theDirectory := theDirectory containingDirectory].
- 	^theDirectory!

Item was removed:
- ----- Method: StandardFileMenu>>startUpWithCaption:at: (in category 'basic control sequences') -----
- startUpWithCaption: aString at: location
- 
- 	|result|
- 	result := super startUpWithCaption: aString at: location.
- 	result ifNil: [^nil].
- 	result isDirectory ifTrue:
- 		[self makeFileMenuFor: result directory.
- 		 self computeForm.
- 		 ^self startUpWithCaption: aString at: location].
- 	result isCommand ifTrue: 
- 		[result := self getTypedFileName: result.
- 		result ifNil: [^nil]].
- 	canTypeFileName ifTrue: [^self confirmExistingFiles: result].
- 	^result
- 	!

Item was removed:
- ----- Method: StandardFileMenu class>>oldFileMenu:withPatternList: (in category 'instance creation') -----
- oldFileMenu: aDirectory withPatternList: aPatternList
- 
- 	Smalltalk isMorphic ifFalse: [^PluggableFileList oldFileMenu: aDirectory].
- 	^super new oldFileFrom: aDirectory withPatternList: aPatternList!

Item was removed:
- ----- Method: StandardFileMenu class>>newFileStream (in category 'standard file operations') -----
- newFileStream
- 
- 	^self newFileStreamFrom: (FileDirectory default)!

Item was removed:
- ----- Method: StandardFileMenu class>>newFileMenu:withPatternList: (in category 'instance creation') -----
- newFileMenu: aDirectory withPatternList: aPatternList
- 	Smalltalk isMorphic ifFalse: [^ PluggableFileList newFileMenu: aDirectory].
- 	^ super new newFileFrom: aDirectory withPatternList: aPatternList!

Item was removed:
- ----- Method: StandardFileMenu>>confirmExistingFiles: (in category 'basic control sequences') -----
- confirmExistingFiles: aResult
- 
- 	|choice|
- 	(aResult directory fileExists: aResult name) ifFalse: [^aResult].
- 	
- 	choice := (UIManager default chooseFrom: #('overwrite that file' 'choose another name'
-  'cancel')
- 		title: aResult name, '
- already exists.').
- 
- 	choice = 1 ifTrue: [
- 		aResult directory 
- 			deleteFileNamed: aResult name
- 			ifAbsent: 
- 				[^self startUpWithCaption: 
- 'Can''t delete ', aResult name, '
- Select another file'].
- 		^aResult].
- 	choice = 2 ifTrue: [^self startUpWithCaption: 'Select Another File'].
- 	^nil
-  !

Item was removed:
- ----- Method: StandardFileMenu>>menuLinesArray: (in category 'menu building') -----
- menuLinesArray: aDirectory
- "Answer a menu lines object corresponding to aDirectory"
- 
- 	| typeCount nameCnt dirDepth|
- 	typeCount := canTypeFileName 
- 		ifTrue: [1] 
- 		ifFalse: [0].
- 	nameCnt := aDirectory directoryNames size.
- 	dirDepth := aDirectory pathParts size.
- 	^Array streamContents: [:s |
- 		canTypeFileName ifTrue: [s nextPut: 1].
- 		s nextPut: dirDepth + typeCount + 1.
- 		s nextPut: dirDepth + nameCnt + typeCount + 1]!

Item was removed:
- ----- Method: StandardFileMenu>>makeFileMenuFor: (in category 'menu building') -----
- makeFileMenuFor: aDirectory
- "Initialize an instance of me to operate on aDirectory"
- 
- 	| theMenu |
- 	pattern ifNil: [pattern := {'*'}].
- 	Cursor wait showWhile: 
- 		[self 
- 			labels: 	(self menuLabelsString: aDirectory)
- 			font: 	(MenuStyle fontAt: 1) 
- 			lines: 	(self menuLinesArray: aDirectory).
- 		theMenu := self selections: (self menuSelectionsArray: aDirectory)].
- 	^theMenu!

Item was removed:
- ----- Method: StandardFileMenu>>oldFileFrom:withPatternList: (in category 'private') -----
- oldFileFrom: aDirectory withPatternList: aPatternList
- 
- 	canTypeFileName := false.
- 	pattern := aPatternList.
- 	^self makeFileMenuFor: aDirectory!



More information about the Packages mailing list