It looks like you're converting some := assignements to underscore assignments...
On Wed, Aug 31, 2016 at 4:34 AM, commits@source.squeak.org wrote:
Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.872.mcz
==================== Summary ====================
Name: System-tfel.872 Author: tfel Time: 6 August 2016, 1:52:05.699519 pm UUID: 488c4f3a-c6f2-4f08-92ce-136da38c76ac Ancestors: System-tfel.871
don't error when there are no translations available
=============== 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 |
that want to be in outPointers. Return blockers, an IdentityDictionary of objects to replace in outPointers."| refs ours blockers known | "Put all traced objects into my arrayOfRoots. Remove some
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: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID:inDomain: (in category 'translation') ----- translateWithoutLoading: aString toLocaleID: localeID inDomain: aDomainName "try to translate with small footprint: if GetTextTranslator hasn't loaded MO, try to use InternalTranslator. if InternalTranslator isn't available, then actually load MO and use it" | translator | translator := self availableForLocaleID: localeID.
translator class = NaturalLanguageTranslator ifTrue: [^ aString]. (translator isDomainLoaded: aDomainName) ifFalse: [ (InternalTranslator availableLanguageLocaleIDs includes: localeID) ifTrue: [translator := InternalTranslator localeID: localeID]. ]. ^translator translate: aString inDomain: aDomainName!
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.
'Sorry, I cannot find the user list. (this may be due to a network problem)userList := eToyAuthentificationServer eToyUserList. userList ifNil:[ self inform:
- 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'.]!
On 31.08.2016, at 23:15, Chris Muller asqueaker@gmail.com wrote:
It looks like you're converting some := assignements to underscore assignments...
It looks like but it ain't. See other messages of Tim. It's just the ancestry being pulled in and Squeaksource being oblivious about that.
Best regards -Tobias
On Wed, Aug 31, 2016 at 4:34 AM, commits@source.squeak.org wrote:
Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.872.mcz
==================== Summary ====================
Name: System-tfel.872 Author: tfel Time: 6 August 2016, 1:52:05.699519 pm UUID: 488c4f3a-c6f2-4f08-92ce-136da38c76ac Ancestors: System-tfel.871
don't error when there are no translations available
=============== 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: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID:inDomain: (in category 'translation') ----- translateWithoutLoading: aString toLocaleID: localeID inDomain: aDomainName "try to translate with small footprint: if GetTextTranslator hasn't loaded MO, try to use InternalTranslator. if InternalTranslator isn't available, then actually load MO and use it" | translator | translator := self availableForLocaleID: localeID.
translator class = NaturalLanguageTranslator ifTrue: [^ aString]. (translator isDomainLoaded: aDomainName) ifFalse: [ (InternalTranslator availableLanguageLocaleIDs includes: localeID) ifTrue: [translator := InternalTranslator localeID: localeID]. ]. ^translator translate: aString inDomain: aDomainName!
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'.]!
squeak-dev@lists.squeakfoundation.org