[squeak-dev] The Trunk: System-tfel.872.mcz
Tobias Pape
Das.Linux at gmx.de
Wed Aug 31 21:23:59 UTC 2016
On 31.08.2016, at 23:15, Chris Muller <asqueaker at 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 at 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'.]!
More information about the Squeak-dev
mailing list
|