[squeak-dev] The Trunk: System-tfel.871.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Aug 31 09:37:24 UTC 2016


Tim Felgentreff uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-tfel.871.mcz

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

Name: System-tfel.871
Author: tfel
Time: 6 August 2016, 1:10:56.953657 pm
UUID: 73462584-e3ec-422a-961a-fa10bf629706
Ancestors: System-mt.870, System-tfel.858

merge with trunk

=============== Diff against System-mt.870 ===============

Item was changed:
  ----- Method: CodeLoader>>installProject (in category 'installing') -----
  installProject
  	"Assume that we're loading a single file and it's a project"
  	| aStream |
+ 	aStream _ sourceFiles first contentStream.
- 	aStream := sourceFiles first contentStream.
  	aStream ifNil:[^self error:'Project was not loaded'].
+ 	ProjectLoading openOn: aStream!
- 	ProjectLoading
- 			openName: nil 		"<--do we want to cache this locally? Need a name if so"
- 			stream: aStream
- 			fromDirectory: nil
- 			withProjectView: nil.
- !

Item was changed:
  ----- Method: ExternalDropHandler class>>defaultProjectHandler (in category 'private') -----
  defaultProjectHandler
+ 	^ ExternalDropHandler
- 	^ExternalDropHandler
  		type: nil
  		extension: 'pr'
+ 		action: [:stream | ProjectLoading openOn: stream]!
- 		action: [:stream |
- 				ProjectLoading
- 					openName: nil
- 					stream: stream
- 					fromDirectory: nil
- 					withProjectView: nil]
- !

Item was changed:
  ----- Method: ExternalSettings class>>assuredPreferenceDirectory (in category 'accessing') -----
  assuredPreferenceDirectory
  	"Answer the preference directory, creating it if necessary"
  
+ 	|  prefDir topDir |
- 	|  prefDir |
  	prefDir := self preferenceDirectory.
  	prefDir
  		ifNil:
+ 			[topDir := Preferences startInUntrustedDirectory
+ 				ifTrue: [FileDirectory on: SecurityManager default secureUserDirectory]
+ 				ifFalse: [FileDirectory default].
+ 			prefDir := topDir directoryNamed: self preferenceDirectoryName.
- 			[prefDir := FileDirectory default directoryNamed: self preferenceDirectoryName.
  			prefDir assureExistence].
  	^ prefDir!

Item was added:
+ ----- Method: GetTextTranslator>>moFiles (in category 'private') -----
+ moFiles
+ 
+ 	^ moFiles!

Item was changed:
  ----- Method: ImageSegment>>declareAndPossiblyRename: (in category 'fileIn/Out') -----
  declareAndPossiblyRename: classThatIsARoot
  	| existing catInstaller |
  	"The class just arrived in this segment.  How fit it into the Smalltalk dictionary?  If it had an association, that was installed with associationDeclareAt:."
  
+ 	catInstaller _ [
- 	catInstaller := [
  		classThatIsARoot superclass name == #Player 
  			ifTrue: [classThatIsARoot category: Object categoryForUniclasses]
  			ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor')
  				ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects']
+ 				ifFalse: [classThatIsARoot category: Object categoryForUniclasses]].
- 				ifFalse: [classThatIsARoot category: 'Morphic-Imported']].
  	].
  	classThatIsARoot superclass addSubclass: classThatIsARoot.
  	(Smalltalk includesKey: classThatIsARoot name) ifFalse: [
  		"Class entry in Smalltalk not referred to in Segment, install anyway."
  		catInstaller value.
  		^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
+ 	existing _ Smalltalk at: classThatIsARoot name.
- 	existing := Smalltalk at: classThatIsARoot name.
  	existing xxxClass == ImageSegmentRootStub ifTrue: [
  		"We are that segment!!  Must ask it carefully!!"
  		catInstaller value.
  		^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  	existing == false | (existing == nil) ifTrue: [
  		"association is in outPointers, just installed"
  		catInstaller value.
  		^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  	"Conflict with existing global or copy of the class"
  	(existing isKindOf: Class) ifTrue: [
  		classThatIsARoot isSystemDefined not ifTrue: [
  			"UniClass.  give it a new name"
  			classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName.
  			catInstaller value.	"must be after new name"
  			^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  		"Take the incoming one"
  		self inform: 'Using newly arrived version of ', classThatIsARoot name.
  		classThatIsARoot superclass removeSubclass: classThatIsARoot.	"just in case"
  		(Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot.
  		catInstaller value.
  		^ classThatIsARoot superclass addSubclass: classThatIsARoot].
  	self error: 'Name already in use by a non-class: ', classThatIsARoot name.
  !

Item was changed:
  ----- Method: ImageSegment>>smartFillRoots: (in category 'read/write segment') -----
  smartFillRoots: dummy
+ 	| refs known ours ww blockers |
- 	| refs ours blockers known |
  	"Put all traced objects into my arrayOfRoots.  Remove some
  that want to be in outPointers.  Return blockers, an
  IdentityDictionary of objects to replace in outPointers."
  
+ 	blockers _ dummy blockers.
+ 	known _ (refs _ dummy references) size.
- 	blockers := dummy blockers.
- 	known := (refs := dummy references) size.
  	refs keys do: [:obj | "copy keys to be OK with removing items"
+ 		(obj isSymbol) ifTrue: [refs removeKey: obj.  known _ known-1].
- 		(obj isSymbol) ifTrue: [refs removeKey: obj.
- known := known-1].
  		(obj class == PasteUpMorph) ifTrue: [
  			obj isWorldMorph & (obj owner == nil) ifTrue: [
+ 				(dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [
+ 					refs removeKey: obj.  known _ known-1.
- 				obj == dummy project world ifFalse: [
- 					refs removeKey: obj.  known := known-1.
  					blockers at: obj put:
+ 						(StringMorph contents: 'The worldMorph of a different world')]]].
- 						(StringMorph
- contents: 'The worldMorph of a different world')]]].
  					"Make a ProjectViewMorph here"
  		"obj class == Project ifTrue: [Transcript show: obj; cr]."
  		(blockers includesKey: obj) ifTrue: [
+ 			refs removeKey: obj ifAbsent: [known _ known+1].  known _ known-1].
- 			refs removeKey: obj ifAbsent: [known :=
- known+1].  known := known-1].
  		].
+ 	ours _ dummy project ifNotNil: [dummy project world] ifNil: [ActiveWorld].
+ 	refs keysDo: [:obj |
- 	ours := dummy project world.
- 	refs keysDo: [:obj | | ww |
  			obj isMorph ifTrue: [
+ 				ww _ obj world.
- 				ww := obj world.
  				(ww == ours) | (ww == nil) ifFalse: [
+ 					refs removeKey: obj.  known _ known-1.
+ 					blockers at: obj put: (StringMorph contents:
+ 								obj printString, ' from another world')]]].
- 					refs removeKey: obj.  known := known-1.
- 					blockers at: obj put:
- (StringMorph contents:
- 								obj
- printString, ' from another world')]]].
  	"keep original roots on the front of the list"
  	(dummy rootObject) do: [:rr | refs removeKey: rr ifAbsent: []].
+ 	self classOrganizersBeRoots: dummy.
+ 	^ dummy rootObject, refs fasterKeys asArray.!
- 	^ dummy rootObject, refs keys asArray.
- 
- !

Item was changed:
  ----- Method: MOFile>>searchByDictionary: (in category 'public') -----
  searchByDictionary: aString
  	| index |
+ 	index := translations at: aString ifAbsentPut: [nil].
+ 	index ifNil: [^ nil].
+ 	^self translatedString: index!
- 	index := translations at: aString ifAbsent: [^nil].
- 	^self translatedString: index
- 	
- !

Item was added:
+ ----- Method: MOFile>>translations (in category 'private') -----
+ translations
+ 
+ 	^ translations!

Item was changed:
  ----- Method: MczInstaller class>>serviceLoadVersion (in category 'services') -----
  serviceLoadVersion
  	^ SimpleServiceEntry
  		provider: self
+ 		label: 'load' translatedNoop
- 		label: 'load'
  		selector: #loadVersionFile:
+ 		description: 'load a package version' translatedNoop!
- 		description: 'load a package version'!

Item was changed:
  ----- Method: Preference>>helpString (in category 'menu') -----
  helpString
  	"Answer the help string provided for the receiver"
  
+ 	^ helpString ifNil: ['no help available' translatedNoop]!
- 	^ helpString ifNil: ['no help available']!

Item was removed:
- ----- Method: Preferences class>>alwaysShowConnectionVocabulary (in category 'standard queries') -----
- alwaysShowConnectionVocabulary
- 	^ self
- 		valueOfFlag: #alwaysShowConnectionVocabulary
- 		ifAbsent: [false]!

Item was changed:
+ ----- Method: Preferences class>>chooseEToysTitleFont (in category 'fonts') -----
- ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') -----
  chooseEToysTitleFont
+ 	"Present a menu with the possible fonts for etoy titles"
+ 
- 	"present a menu with the possible fonts for the eToys"
  	self
+ 		chooseFontWithPrompt: 'Choose the etoy title font' translated
- 		chooseFontWithPrompt: 'eToys Title font...' translated
  		andSendTo: self
  		withSelector: #setEToysTitleFontTo:
+ 		highlight: self standardEToysTitleFont!
- 		highlightSelector: #standardEToysTitleFont!

Item was removed:
- ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') -----
- haloTheme
- 	^ self
- 		valueOfFlag: #haloTheme
- 		ifAbsent: [ #iconicHaloSpecifications ]!

Item was changed:
+ ----- Method: Preferences class>>iconicHaloSpecifications (in category 'halos') -----
- ----- Method: Preferences class>>iconicHaloSpecifications (in category 'prefs - halos') -----
  iconicHaloSpecifications
  	"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
  
  	"Preferences resetHaloSpecifications"
  
  	^ #(
  	"  	selector				horiz		vert			color info						icon key
  		---------				------		-----------		-------------------------------		---------------"
  	(addCollapseHandle:		left			topCenter		(tan)							'Halo-Collapse')
  	(addPoohHandle:			right		center			(white)							'Halo-Pooh')
  	(addDebugHandle:		right		topCenter		(blue	veryMuchLighter)		'Halo-Debug')
  	(addDismissHandle:		left			top				(red		muchLighter)			'Halo-Dismiss')
  	(addRotateHandle:		left			bottom			(blue)							'Halo-Rot')
+ 	(addMenuHandle:		leftCenter	top				(white)							'Halo-Menu')
- 	(addMenuHandle:		leftCenter	top				(red)							'Halo-Menu')
  	(addTileHandle:			left			bottomCenter	(lightBrown)					'Halo-Tile')
  	(addViewHandle:			left			center			(cyan)							'Halo-View')
  	(addGrabHandle:			center		top				(black)							'Halo-Grab')
  	(addDragHandle:			rightCenter	top				(brown)							'Halo-Drag')
  	(addDupHandle:			right		top				(green)							'Halo-Dup')	
  	(addMakeSiblingHandle:	right		top				(green muchDarker)				'Halo-Dup')	
  	(addHelpHandle:			center		bottom			(lightBlue)						'Halo-Help')
  	(addGrowHandle:		right		bottom			(yellow)						'Halo-Scale')
  	(addScaleHandle:		right		bottom			(lightOrange)					'Halo-Scale')
  	(addScriptHandle:		rightCenter	bottom			(green muchLighter)			'Halo-Script')
  	(addPaintBgdHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addViewingHandle:		leftCenter	bottom			(lightGreen lighter)				'Halo-View')
  	(addRepaintHandle:		right		center			(lightGray)						'Halo-Paint')
  	(addFontSizeHandle:		leftCenter	bottom			(lightGreen)						'Halo-FontSize')
  	(addFontStyleHandle:		center		bottom			(lightRed)						'Halo-FontStyle')
  	(addFontEmphHandle:	rightCenter	bottom			(lightBrown darker)				'Halo-FontEmph')
  	(addRecolorHandle:		right		bottomCenter	(magenta darker)				'Halo-Recolor')
  	(addChooseGraphicHandle:	right	bottomCenter	(green muchLighter)			'Halo-ChooseGraphic')
  		) !

Item was changed:
+ ----- Method: Preferences class>>menuColorString (in category 'misc') -----
- ----- Method: Preferences class>>menuColorString (in category 'support - misc') -----
  menuColorString
  	^ ((self valueOfFlag: #menuColorFromWorld)
+ 		ifTrue: ['stop menu-color-from-world' translated]
+ 		ifFalse: ['start menu-color-from-world' translated]) !
- 		ifTrue: ['stop menu-color-from-world']
- 		ifFalse: ['start menu-color-from-world']) translated!

Item was changed:
+ ----- Method: Preferences class>>restorePersonalPreferences (in category 'personalization') -----
- ----- Method: Preferences class>>restorePersonalPreferences (in category 'initialization - save/load') -----
  restorePersonalPreferences
  	"Restore all the user's saved personal preference settings"
  
  	| savedPrefs |
+ 	savedPrefs _ self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet' translated].
- 	savedPrefs := self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet'].
  
  	savedPrefs associationsDo:
+ 		[:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNilDo:
- 		[:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNil:
  			[:pref | pref preferenceValue: assoc value preferenceValue]]!

Item was changed:
+ ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'personalization') -----
- ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'initialization - save/load') -----
  restorePreferencesFromDisk
+ 	| result |
+ 	result := (FileList2 modalFileSelectorForSuffixes: #('prefs')) .
+ 	result ifNil: [^ self].
+ 	self restorePreferencesFromDisk: result fullName
+ 		
- 	(FileDirectory default fileExists: 'my.prefs')
- 		ifTrue: [ Cursor wait showWhile: [
- 			[ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' ]
- 		] ]
- 		ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' ].
  	!

Item was removed:
- ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') -----
- showAdvancedNavigatorButtons
- 	^ self
- 		valueOfFlag: #showAdvancedNavigatorButtons
- 		ifAbsent: [ true ]!

Item was changed:
+ ----- Method: Preferences class>>storePreferencesToDisk (in category 'personalization') -----
- ----- Method: Preferences class>>storePreferencesToDisk (in category 'initialization - save/load') -----
  storePreferencesToDisk
+ 	| newName |
+ 	newName := UIManager default request: 'Please confirm name for save...' initialAnswer: 'myPreferences'.
+ 	newName isEmpty
+ 		ifTrue: [^ self].
+ 	Cursor wait
+ 		showWhile: [[self storePreferencesIn: newName , '.prefs']
+ 				on: Error
+ 				do: [:ex | self inform: 'there was an error storing your preferences to disk. you probably already have stored your preferences' translated]]!
- 	Cursor wait showWhile: [
- 		[ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' ]]!

Item was removed:
- ----- Method: Preferences class>>useSmartLabels (in category 'standard queries') -----
- useSmartLabels
- 	^ self
- 		valueOfFlag: #useSmartLabels
- 		ifAbsent: [false]!

Item was changed:
  ----- Method: Project class>>mostRecent:onServer: (in category 'squeaklet on server') -----
  mostRecent: projName onServer: aServerDirectory
  	| stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName |
  	"Find the exact fileName of the most recent version of project with the stem name of projName.  Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number.
  	File names may or may not be HTTP escaped, %20 on the server."
  
  	self flag: #bob.		"do we want to handle unversioned projects as well?"
+ 						"I think we do now - Yoshiki."
  
+ 	nothingFound _ {nil. -1}.
- 	nothingFound := {nil. -1}.
  	aServerDirectory ifNil: [^nothingFound].
  	"23 sept 2000 - some old projects have periods in name so be more careful"
+ 	unEscName _ projName unescapePercents.
+ 	triple _ Project parseProjectFileName: unEscName.
+ 	stem _ triple first.
+ 	rawList _ aServerDirectory fileNames.
- 	unEscName := projName unescapePercents.
- 	triple := Project parseProjectFileName: unEscName.
- 	stem := triple first.
- 	rawList := aServerDirectory fileNames.
  
+ 	rawList isString ifTrue: [self inform: 'server is unavailable' translated. ^nothingFound].
+ 	list _ rawList collect: [:nnn | nnn unescapePercents].
+ 	max _ -1.  goodName _ nil.
- 	rawList isString ifTrue: [self inform: 'server is unavailable'. ^nothingFound].
- 	list := rawList collect: [:nnn | nnn unescapePercents].
- 	max := -1.  goodName := nil.
  	list withIndexDo: [:aName :ind |
+ 		((aName beginsWith: stem)) ifTrue: [
+ 			((aName endsWith: triple last) or: [triple last = '' and: [aName endsWith: '.pr']]) ifTrue: [
+ 			num _ (Project parseProjectFileName: aName) second.
+ 			num > max ifTrue: [max _ num.  goodName _ (rawList at: ind)]]]].
- 		(aName beginsWith: stem) ifTrue: [
- 			num := (Project parseProjectFileName: aName) second.
- 			num > max ifTrue: [max := num.  goodName := (rawList at: ind)]]].
  
  	max = -1 ifFalse: [^ Array with: goodName with: max].
  
  	"try with underbar for spaces on server"
  	(stem includes: $ ) ifTrue: [
+ 		stem1 _ stem copyReplaceAll: ' ' with: '_'.
- 		stem1 := stem copyReplaceAll: ' ' with: '_'.
  		list withIndexDo: [:aName :ind |
  			(aName beginsWith: stem1) ifTrue: [
+ 				num _ (Project parseProjectFileName: aName) second.
+ 				num > max ifTrue: [max _ num.  goodName _ (rawList at: ind)]]]].
- 				num := (Project parseProjectFileName: aName) second.
- 				num > max ifTrue: [max := num.  goodName := (rawList at: ind)]]]].
  	max = -1 ifFalse: [^ Array with: goodName with: max].
  	
  	"try without the marker | "
+ 	stem1 _ stem allButLast, '.pr'.
+ 	stem2 _ stem1 copyReplaceAll: ' ' with: '_'.	"and with spaces replaced"
- 	stem1 := stem allButLast, '.pr'.
- 	stem2 := stem1 copyReplaceAll: ' ' with: '_'.	"and with spaces replaced"
  	list withIndexDo: [:aName :ind |
  		(aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [
+ 			(triple _ aName findTokens: '.') size >= 2 ifTrue: [
+ 				max _ 0.  goodName _ (rawList at: ind)]]].	"no other versions"
- 			(triple := aName findTokens: '.') size >= 2 ifTrue: [
- 				max := 0.  goodName := (rawList at: ind)]]].	"no other versions"
  	max = -1 ifFalse: [^ Array with: goodName with: max].
  
  	^nothingFound		"no matches"
  !

Item was changed:
  ----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') -----
  squeakletDirectory
  
  	| squeakletDirectoryName |
+ 	squeakletDirectoryName := SugarLauncher current
+ 		parameterAt: 'SQUEAKLETS'
+ 		ifAbsent: ['Squeaklets'].
- 	squeakletDirectoryName := 'Squeaklets'.
  	(FileDirectory default directoryExists: squeakletDirectoryName) ifFalse: [
  		FileDirectory default createDirectory: squeakletDirectoryName
  	].
  	^FileDirectory default directoryNamed: squeakletDirectoryName!

Item was changed:
  ----- Method: Project class>>sweep: (in category 'squeaklet on server') -----
  sweep: aServerDirectory
  	| repository list parts ind entry projectName versions |
  	"On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'"
  	"Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone 
  				directory: '/vol0/people/dani/Squeaklets/2.7')"
  
  	"Ensure the 'older' directory"
  	(aServerDirectory includesKey: 'older') 
  		ifFalse: [aServerDirectory createDirectory: 'older'].
+ 	repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'.
- 	repository := aServerDirectory clone directory: aServerDirectory directory, '/older'.
  
  	"Collect each name, and decide on versions"
+ 	list _ aServerDirectory fileNames.
+ 	list isString ifTrue: [^ self inform: 'server is unavailable' translated].
+ 	list _ list asSortedCollection asOrderedCollection.
+ 	parts _ list collect: [:en | Project parseProjectFileName: en].
+ 	parts _ parts select: [:en | en third = 'pr'].
+ 	ind _ 1.
+ 	[entry _ list at: ind.
+ 		projectName _ entry first asLowercase.
+ 		versions _ OrderedCollection new.  versions add: entry.
+ 		[(ind _ ind + 1) > list size 
- 	list := aServerDirectory fileNames.
- 	list isString ifTrue: [^ self inform: 'server is unavailable'].
- 	list := list asSortedCollection asOrderedCollection.
- 	parts := list collect: [:en | Project parseProjectFileName: en].
- 	parts := parts select: [:en | en third = 'pr'].
- 	ind := 1.
- 	[entry := list at: ind.
- 		projectName := entry first asLowercase.
- 		versions := OrderedCollection new.  versions add: entry.
- 		[(ind := ind + 1) > list size 
  			ifFalse: [(parts at: ind) first asLowercase = projectName 
  				ifTrue: [versions add: (parts at: ind).  true]
  				ifFalse: [false]]
  			ifTrue: [false]] whileTrue.
  		aServerDirectory moveYoungest: 3 in: versions to: repository.
  		ind > list size] whileFalse.
  !

Item was changed:
  ----- Method: Project>>depth (in category 'active process') -----
  depth
  	"Return the depth of this project from the top.
  	 topProject = 0, next = 1, etc."
  	"Project current depth."
  
+ 	| depth project |
+ 	depth _ 0.
+ 	project _ self.
- 	| depth topProject project |
- 	depth := 0.
- 	topProject := Project topProject.
- 	project := self.
  	
+ 	[project class == DiskProxy ifTrue: [^ depth].
+ 	 project isTopProject]
+ 		whileFalse:
+ 			[project _ project parent.
+ 			depth _ depth + 1].
- 	[project ~= topProject and:[project notNil]]
- 		whileTrue:
- 			[project := project parent.
- 			depth := depth + 1].
  	^ depth!

Item was changed:
  ----- Method: Project>>doWeWantToRename (in category 'menu messages') -----
  doWeWantToRename
  
  	| want |
  
  	self hasBadNameForStoring ifTrue: [^true].
+ 	(self name beginsWith: 'Unnamed' translated) ifTrue: [^true].
+ 	want _ world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
- 	(self name beginsWith: 'Unnamed') ifTrue: [^true].
- 	want := world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
  	world removeProperty: #SuperSwikiRename.
  	^want
  
  !

Item was changed:
  ----- Method: Project>>htmlPagePrototype (in category 'file in/out') -----
  htmlPagePrototype
  	"Return the HTML page prototype"
  ^'<html>
  <head>
  <title>Squeak Project</title>
  <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
  </head>
  
  <body bgcolor="#FFFFFF">
  <EMBED 
  	type="application/x-squeak-source"
  	ALIGN="CENTER"
  	WIDTH="$$WIDTH$$"
  	HEIGHT="$$HEIGHT$$"
  	src="$$PROJECT$$"
+ 	pluginspage="http://www.squeakland.org/download/">
- 	pluginspage="http://www.squeakland.org/plugin/detect/detectinstaller.html">
  
  </EMBED>
  
  </body>
  </html>
  '!

Item was changed:
  ----- Method: Project>>revert (in category 'file in/out') -----
  revert
  	| |
  	"Exit this project and do not save it.  Warn user unless in dangerous projectRevertNoAsk mode.  Exit to the parent project.  Do a revert on a clone of the segment, to allow later reverts."
  
+ 	projectParameters ifNil: [^ self inform: 'nothing to revert to' translated].
- 	projectParameters ifNil: [^ self inform: 'nothing to revert to'].
  	parentProject enter: false revert: true saveForRevert: false.
  	"does not return!!"
  !

Item was changed:
  ----- Method: Project>>storeOnServer (in category 'file in/out') -----
  storeOnServer
  
  	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
  
  	world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ 	self validateProjectNameIfOK: [:details |
+ 		self acceptProjectDetails: details.
- 	self validateProjectNameIfOK: [
  		self isCurrentProject ifTrue: ["exit, then do the command"
  			^ self 
  				armsLengthCommand: #storeOnServerAssumingNameValid
  				withDescription: 'Publishing' translated
  		].
  		self storeOnServerWithProgressInfo.
  	].!

Item was changed:
  ----- Method: Project>>storeOnServerAssumingNameValid (in category 'file in/out') -----
  storeOnServerAssumingNameValid
  
  	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
- 
  	world setProperty: #optimumExtentFromAuthor toValue: world extent.
  	self isCurrentProject ifTrue: ["exit, then do the command"
+ 		Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true].
  		^ self 
  			armsLengthCommand: #storeOnServerAssumingNameValid
  			withDescription: 'Publishing' translated
  	].
  	self storeOnServerWithProgressInfo.
  !

Item was changed:
  ----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') -----
  storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget
  
  	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
  
  	world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ 	self validateProjectNameIfOK: [:details |
+ 		self acceptProjectDetails: details.
- 	self validateProjectNameIfOK: [
  		self isCurrentProject ifTrue: ["exit, then do the command"
  			forget
  				ifTrue: [self forgetExistingURL]
  				ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]].
  			^self
  				armsLengthCommand: #storeOnServerAssumingNameValid
  				withDescription: 'Publishing' translated
  		].
  		self storeOnServerWithProgressInfoOn: aMorphOrNil.
  	].
  !

Item was changed:
  ----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
  validateProjectNameIfOK: aBlock
  
  	| details |
  
  	details := world valueOfProperty: #ProjectDetails.
  	details ifNotNil: ["ensure project info matches real project name"
  		details at: 'projectname' put: self name.
  	].
+ 	self doWeWantToRename ifFalse: [^ aBlock value: details].
- 	self doWeWantToRename ifFalse: [^aBlock value].
  	(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
  		etpdm
  			getFullInfoFor: self 
+ 			ifValid: [:d |
- 			ifValid: [
  				World displayWorldSafely.
+ 				aBlock value: d
- 				aBlock value.
  			]
  			expandedFormat: false]
  !

Item was changed:
  ----- Method: ProjectLauncher>>loginAs: (in category 'eToy login') -----
  loginAs: userName
  	"Assuming that we have a valid user url; read its contents and see if the user is really there."
  	| actualName userList |
  	eToyAuthentificationServer ifNil:[
  		self proceedWithLogin.
  		^true].
+ 	userList _ eToyAuthentificationServer eToyUserList.
- 	userList := eToyAuthentificationServer eToyUserList.
  	userList ifNil:[
  		self inform:
  'Sorry, I cannot find the user list.
  (this may be due to a network problem)
+ Please hit Cancel if you wish to use Squeak.' translated.
- Please hit Cancel if you wish to use Squeak.'.
  		^false].
  	"case insensitive search"
+ 	actualName  _ userList detect:[:any| any sameAs: userName] ifNone:[nil].
- 	actualName  := userList detect:[:any| any sameAs: userName] ifNone:[nil].
  	actualName isNil ifTrue:[
+ 		self inform: 'Unknown user: ' translated ,userName.
- 		self inform: 'Unknown user: ',userName.
  		^false].
  	Utilities authorName: actualName.
  	eToyAuthentificationServer eToyUserName: actualName.
  	self proceedWithLogin.
  	^true!

Item was changed:
  ----- Method: SARInstaller class>>serviceFileInSAR (in category 'class initialization') -----
  serviceFileInSAR
  	"Answer a service for opening a changelist browser on a file"
  
  	^ SimpleServiceEntry 
  		provider: self 
+ 		label: 'install SAR' translatedNoop
- 		label: 'install SAR'
  		selector: #installSAR:
+ 		description: 'install this Squeak ARchive into the image.' translatedNoop
+ 		buttonLabel: 'install' translatedNoop!
- 		description: 'install this Squeak ARchive into the image.'
- 		buttonLabel: 'install'!

Item was changed:
  ----- Method: SystemVersion>>majorMinorVersion (in category 'accessing') -----
  majorMinorVersion
  	"Return the major/minor version number of the form X.Y, without any 'alpha' or 'beta' or other suffix."
- 	"(SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion" "  -->  'Squeak3.7' "
- 	"SystemVersion current majorMinorVersion"
  	
  	| char stream |
+ 	^ (version includes: $.)
+ 		ifTrue:
+ 			[stream := ReadStream on: version, 'x'.
+ 			stream upTo: $..
+ 			char := stream next.
+ 			[char isDigit]
+ 				whileTrue: [char := stream next].
+ 			version copyFrom: 1 to: stream position - 1]
+ 		ifFalse:
+ 			[version]
+ 
+ "
+ (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion
+ (SystemVersion new version: 'Testing') majorMinorVersion
+ SystemVersion current majorMinorVersion
+ "
+ 
- 	stream := ReadStream on: version, 'x'.
- 	stream upTo: $..
- 	char := stream next.
- 	char ifNil: [^ version].	"eg: 'Jasmine-rc1' has no $. in it."
- 	[char isDigit]
- 		whileTrue: [char := stream next].
- 	^ version copyFrom: 1 to: stream position - 1
  !

Item was changed:
  ----- Method: TextStyle>>addNewFontSize: (in category '*System-Fonts') -----
  addNewFontSize: pointSize
  	"Add a font in specified size to the array of fonts."
  	| f d newArray t isSet |
  	fontArray first emphasis ~= 0 ifTrue: [
  		t := TextConstants at: self fontArray first familyName asSymbol.
  		t fonts first emphasis = 0 ifTrue: [
  			^ t addNewFontSize: pointSize.
  		].
  	].
  
  	pointSize <= 0 ifTrue: [^ nil].
  	fontArray do: [:s |
  		s pointSize = pointSize ifTrue: [^ s].
  	].
  
  	(isSet := fontArray first isKindOf: TTCFontSet) 
  	ifTrue:[
  		| fonts |
  		fonts := fontArray first fontArray collect: [ :font |
  			| newFont |
  			(font isNil)
  			ifTrue: [newFont := nil]
  			ifFalse: [
  				newFont := (font ttcDescription size > 256)
  					ifTrue: [MultiTTCFont new initialize]
  					ifFalse: [TTCFont new initialize].
  				newFont ttcDescription: font ttcDescription.
  				newFont pixelSize: pointSize * 96 // 72.
  				font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto |
  					proto ifNotNil: [
  						d := proto class new initialize.
  						d ttcDescription: proto ttcDescription.
  						d pixelSize: newFont pixelSize.
  						newFont derivativeFont: d]]].
  				].
  			newFont].
  		f := TTCFontSet newFontArray: fonts]
  	ifFalse: [
  		f := fontArray first class new initialize: fontArray first.
  		f pointSize: pointSize.
  		fontArray first derivativeFonts do: [:proto |
  			proto ifNotNil: [
+ 				d := TTCFont new initialize: proto.
- 				d := proto class new initialize: proto.
  				d pointSize: f pointSize.
+ 				f derivativeFont: d.
- 				f derivativeFont: d mainFont: proto.
  			].
  		].
  	].
  	newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize].
  	self newFontArray: newArray.
  	isSet ifTrue: [
  		TTCFontSet register: newArray at: newArray first familyName asSymbol.
  	].
  	^ self fontOfPointSize: pointSize
  !

Item was changed:
  ----- Method: Utilities class>>floatPrecisionForDecimalPlaces: (in category 'miscellaneous') -----
  floatPrecisionForDecimalPlaces: places
  	"Answer the floatPrecision that corresponds to the given number of decimal places"
  
  	^ places caseOf:
  			{[0]->[1] .
+ 			[1]-> [0.1] . 
+ 			[2]-> [0.01] .
+ 			[3]-> [0.001] .
+ 			[4]-> [0.0001] .
+ 			[5]-> [0.00001] .
+ 			[6]-> [0.000001] .
+ 			[7]-> [0.0000001] .
+ 			[8]-> [0.00000001] .
+ 			[9]-> [0.000000001].
+ 			[10]->[0.0000000001]}
- 			[1]->[0.1] . 
- 			[2]->[0.01] .
- 			[3]->[0.001] .
- 			[4]->[0.0001] .
- 			[5]->[0.00001] .
- 			[6]->[0.000001] .
- 			[7]->[0.0000001] .
- 			[8]->[0.00000001] .
- 			[9]->[0.000000001]}
  		otherwise:
  			[(10.0 raisedTo: places negated) asFloat]
  
  "
  (0 to: 6) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
  (-10 to: 20) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
  "!

Item was changed:
  ----- Method: Utilities class>>registerInFlapsRegistry (in category 'class initialization') -----
  registerInFlapsRegistry
  	"Register the receiver in the system's flaps registry"
  	self environment
  		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#Utilities. #recentSubmissionsWindow. 	'Recent' translatedNoop.		'A message browser that tracks the most recently-submitted methods' translatedNoop}
- 		ifPresent: [:cl | cl registerQuad: #(Utilities	recentSubmissionsWindow	'Recent'		'A message browser that tracks the most recently-submitted methods')
  						forFlapNamed: 'Tools'.]!



More information about the Squeak-dev mailing list