[squeak-dev] The Trunk: System-tfel.872.mcz
Chris Muller
asqueaker at gmail.com
Wed Aug 31 21:15:58 UTC 2016
It looks like you're converting some := assignements to underscore
assignments...
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
|