Squeak-dev August 2016

squeak-dev@lists.squeakfoundation.org

38 participants
609 discussions

The Trunk: System-tfel.871.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.871.mcz ==================== Summary ==================== Name: System-tfel.871 Author: tfel Time: 6 August 2016, 1:10:56.953657 pm UUID: 73462584-e3ec-422a-961a-fa10bf629706 Ancestors: System-mt.870, System-tfel.858 merge with trunk =============== Diff against System-mt.870 =============== Item was changed: ----- Method: CodeLoader>>installProject (in category 'installing') ----- installProject "Assume that we're loading a single file and it's a project" | aStream | + aStream _ sourceFiles first contentStream. - aStream := sourceFiles first contentStream. aStream ifNil:[^self error:'Project was not loaded']. + ProjectLoading openOn: aStream! - ProjectLoading - openName: nil "<--do we want to cache this locally? Need a name if so" - stream: aStream - fromDirectory: nil - withProjectView: nil. - ! Item was changed: ----- Method: ExternalDropHandler class>>defaultProjectHandler (in category 'private') ----- defaultProjectHandler + ^ ExternalDropHandler - ^ExternalDropHandler type: nil extension: 'pr' + action: [:stream | ProjectLoading openOn: stream]! - action: [:stream | - ProjectLoading - openName: nil - stream: stream - fromDirectory: nil - withProjectView: nil] - ! Item was changed: ----- Method: ExternalSettings class>>assuredPreferenceDirectory (in category 'accessing') ----- assuredPreferenceDirectory "Answer the preference directory, creating it if necessary" + | prefDir topDir | - | prefDir | prefDir := self preferenceDirectory. prefDir ifNil: + [topDir := Preferences startInUntrustedDirectory + ifTrue: [FileDirectory on: SecurityManager default secureUserDirectory] + ifFalse: [FileDirectory default]. + prefDir := topDir directoryNamed: self preferenceDirectoryName. - [prefDir := FileDirectory default directoryNamed: self preferenceDirectoryName. prefDir assureExistence]. ^ prefDir! Item was added: + ----- Method: GetTextTranslator>>moFiles (in category 'private') ----- + moFiles + + ^ moFiles! Item was changed: ----- Method: ImageSegment>>declareAndPossiblyRename: (in category 'fileIn/Out') ----- declareAndPossiblyRename: classThatIsARoot | existing catInstaller | "The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:." + catInstaller _ [ - catInstaller := [ classThatIsARoot superclass name == #Player ifTrue: [classThatIsARoot category: Object categoryForUniclasses] ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor') ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects'] + ifFalse: [classThatIsARoot category: Object categoryForUniclasses]]. - ifFalse: [classThatIsARoot category: 'Morphic-Imported']]. ]. classThatIsARoot superclass addSubclass: classThatIsARoot. (Smalltalk includesKey: classThatIsARoot name) ifFalse: [ "Class entry in Smalltalk not referred to in Segment, install anyway." catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. + existing _ Smalltalk at: classThatIsARoot name. - existing := Smalltalk at: classThatIsARoot name. existing xxxClass == ImageSegmentRootStub ifTrue: [ "We are that segment!! Must ask it carefully!!" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. existing == false | (existing == nil) ifTrue: [ "association is in outPointers, just installed" catInstaller value. ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Conflict with existing global or copy of the class" (existing isKindOf: Class) ifTrue: [ classThatIsARoot isSystemDefined not ifTrue: [ "UniClass. give it a new name" classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName. catInstaller value. "must be after new name" ^ Smalltalk at: classThatIsARoot name put: classThatIsARoot]. "Take the incoming one" self inform: 'Using newly arrived version of ', classThatIsARoot name. classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case" (Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot. catInstaller value. ^ classThatIsARoot superclass addSubclass: classThatIsARoot]. self error: 'Name already in use by a non-class: ', classThatIsARoot name. ! Item was changed: ----- Method: ImageSegment>>smartFillRoots: (in category 'read/write segment') ----- smartFillRoots: dummy + | refs known ours ww blockers | - | refs ours blockers known | "Put all traced objects into my arrayOfRoots. Remove some that want to be in outPointers. Return blockers, an IdentityDictionary of objects to replace in outPointers." + blockers _ dummy blockers. + known _ (refs _ dummy references) size. - blockers := dummy blockers. - known := (refs := dummy references) size. refs keys do: [:obj | "copy keys to be OK with removing items" + (obj isSymbol) ifTrue: [refs removeKey: obj. known _ known-1]. - (obj isSymbol) ifTrue: [refs removeKey: obj. - known := known-1]. (obj class == PasteUpMorph) ifTrue: [ obj isWorldMorph & (obj owner == nil) ifTrue: [ + (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [ + refs removeKey: obj. known _ known-1. - obj == dummy project world ifFalse: [ - refs removeKey: obj. known := known-1. blockers at: obj put: + (StringMorph contents: 'The worldMorph of a different world')]]]. - (StringMorph - contents: 'The worldMorph of a different world')]]]. "Make a ProjectViewMorph here" "obj class == Project ifTrue: [Transcript show: obj; cr]." (blockers includesKey: obj) ifTrue: [ + refs removeKey: obj ifAbsent: [known _ known+1]. known _ known-1]. - refs removeKey: obj ifAbsent: [known := - known+1]. known := known-1]. ]. + ours _ dummy project ifNotNil: [dummy project world] ifNil: [ActiveWorld]. + refs keysDo: [:obj | - ours := dummy project world. - refs keysDo: [:obj | | ww | obj isMorph ifTrue: [ + ww _ obj world. - ww := obj world. (ww == ours) | (ww == nil) ifFalse: [ + refs removeKey: obj. known _ known-1. + blockers at: obj put: (StringMorph contents: + obj printString, ' from another world')]]]. - refs removeKey: obj. known := known-1. - blockers at: obj put: - (StringMorph contents: - obj - printString, ' from another world')]]]. "keep original roots on the front of the list" (dummy rootObject) do: [:rr | refs removeKey: rr ifAbsent: []]. + self classOrganizersBeRoots: dummy. + ^ dummy rootObject, refs fasterKeys asArray.! - ^ dummy rootObject, refs keys asArray. - - ! Item was changed: ----- Method: MOFile>>searchByDictionary: (in category 'public') ----- searchByDictionary: aString | index | + index := translations at: aString ifAbsentPut: [nil]. + index ifNil: [^ nil]. + ^self translatedString: index! - index := translations at: aString ifAbsent: [^nil]. - ^self translatedString: index - - ! Item was added: + ----- Method: MOFile>>translations (in category 'private') ----- + translations + + ^ translations! Item was changed: ----- Method: MczInstaller class>>serviceLoadVersion (in category 'services') ----- serviceLoadVersion ^ SimpleServiceEntry provider: self + label: 'load' translatedNoop - label: 'load' selector: #loadVersionFile: + description: 'load a package version' translatedNoop! - description: 'load a package version'! Item was changed: ----- Method: Preference>>helpString (in category 'menu') ----- helpString "Answer the help string provided for the receiver" + ^ helpString ifNil: ['no help available' translatedNoop]! - ^ helpString ifNil: ['no help available']! Item was removed: - ----- Method: Preferences class>>alwaysShowConnectionVocabulary (in category 'standard queries') ----- - alwaysShowConnectionVocabulary - ^ self - valueOfFlag: #alwaysShowConnectionVocabulary - ifAbsent: [false]! Item was changed: + ----- Method: Preferences class>>chooseEToysTitleFont (in category 'fonts') ----- - ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') ----- chooseEToysTitleFont + "Present a menu with the possible fonts for etoy titles" + - "present a menu with the possible fonts for the eToys" self + chooseFontWithPrompt: 'Choose the etoy title font' translated - chooseFontWithPrompt: 'eToys Title font...' translated andSendTo: self withSelector: #setEToysTitleFontTo: + highlight: self standardEToysTitleFont! - highlightSelector: #standardEToysTitleFont! Item was removed: - ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') ----- - haloTheme - ^ self - valueOfFlag: #haloTheme - ifAbsent: [ #iconicHaloSpecifications ]! Item was changed: + ----- Method: Preferences class>>iconicHaloSpecifications (in category 'halos') ----- - ----- Method: Preferences class>>iconicHaloSpecifications (in category 'prefs - halos') ----- iconicHaloSpecifications "Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme" "Preferences resetHaloSpecifications" ^ #( " selector horiz vert color info icon key --------- ------ ----------- ------------------------------- ---------------" (addCollapseHandle: left topCenter (tan) 'Halo-Collapse') (addPoohHandle: right center (white) 'Halo-Pooh') (addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug') (addDismissHandle: left top (red muchLighter) 'Halo-Dismiss') (addRotateHandle: left bottom (blue) 'Halo-Rot') + (addMenuHandle: leftCenter top (white) 'Halo-Menu') - (addMenuHandle: leftCenter top (red) 'Halo-Menu') (addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile') (addViewHandle: left center (cyan) 'Halo-View') (addGrabHandle: center top (black) 'Halo-Grab') (addDragHandle: rightCenter top (brown) 'Halo-Drag') (addDupHandle: right top (green) 'Halo-Dup') (addMakeSiblingHandle: right top (green muchDarker) 'Halo-Dup') (addHelpHandle: center bottom (lightBlue) 'Halo-Help') (addGrowHandle: right bottom (yellow) 'Halo-Scale') (addScaleHandle: right bottom (lightOrange) 'Halo-Scale') (addScriptHandle: rightCenter bottom (green muchLighter) 'Halo-Script') (addPaintBgdHandle: right center (lightGray) 'Halo-Paint') (addViewingHandle: leftCenter bottom (lightGreen lighter) 'Halo-View') (addRepaintHandle: right center (lightGray) 'Halo-Paint') (addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize') (addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle') (addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph') (addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor') (addChooseGraphicHandle: right bottomCenter (green muchLighter) 'Halo-ChooseGraphic') ) ! Item was changed: + ----- Method: Preferences class>>menuColorString (in category 'misc') ----- - ----- Method: Preferences class>>menuColorString (in category 'support - misc') ----- menuColorString ^ ((self valueOfFlag: #menuColorFromWorld) + ifTrue: ['stop menu-color-from-world' translated] + ifFalse: ['start menu-color-from-world' translated]) ! - ifTrue: ['stop menu-color-from-world'] - ifFalse: ['start menu-color-from-world']) translated! Item was changed: + ----- Method: Preferences class>>restorePersonalPreferences (in category 'personalization') ----- - ----- Method: Preferences class>>restorePersonalPreferences (in category 'initialization - save/load') ----- restorePersonalPreferences "Restore all the user's saved personal preference settings" | savedPrefs | + savedPrefs _ self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet' translated]. - savedPrefs := self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet']. savedPrefs associationsDo: + [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNilDo: - [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNil: [:pref | pref preferenceValue: assoc value preferenceValue]]! Item was changed: + ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'personalization') ----- - ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'initialization - save/load') ----- restorePreferencesFromDisk + | result | + result := (FileList2 modalFileSelectorForSuffixes: #('prefs')) . + result ifNil: [^ self]. + self restorePreferencesFromDisk: result fullName + - (FileDirectory default fileExists: 'my.prefs') - ifTrue: [ Cursor wait showWhile: [ - [ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' ] - ] ] - ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' ]. ! Item was removed: - ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') ----- - showAdvancedNavigatorButtons - ^ self - valueOfFlag: #showAdvancedNavigatorButtons - ifAbsent: [ true ]! Item was changed: + ----- Method: Preferences class>>storePreferencesToDisk (in category 'personalization') ----- - ----- Method: Preferences class>>storePreferencesToDisk (in category 'initialization - save/load') ----- storePreferencesToDisk + | newName | + newName := UIManager default request: 'Please confirm name for save...' initialAnswer: 'myPreferences'. + newName isEmpty + ifTrue: [^ self]. + Cursor wait + showWhile: [[self storePreferencesIn: newName , '.prefs'] + on: Error + do: [:ex | self inform: 'there was an error storing your preferences to disk. you probably already have stored your preferences' translated]]! - Cursor wait showWhile: [ - [ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' ]]! Item was removed: - ----- Method: Preferences class>>useSmartLabels (in category 'standard queries') ----- - useSmartLabels - ^ self - valueOfFlag: #useSmartLabels - ifAbsent: [false]! Item was changed: ----- Method: Project class>>mostRecent:onServer: (in category 'squeaklet on server') ----- mostRecent: projName onServer: aServerDirectory | stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName | "Find the exact fileName of the most recent version of project with the stem name of projName. Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number. File names may or may not be HTTP escaped, %20 on the server." self flag: #bob. "do we want to handle unversioned projects as well?" + "I think we do now - Yoshiki." + nothingFound _ {nil. -1}. - nothingFound := {nil. -1}. aServerDirectory ifNil: [^nothingFound]. "23 sept 2000 - some old projects have periods in name so be more careful" + unEscName _ projName unescapePercents. + triple _ Project parseProjectFileName: unEscName. + stem _ triple first. + rawList _ aServerDirectory fileNames. - unEscName := projName unescapePercents. - triple := Project parseProjectFileName: unEscName. - stem := triple first. - rawList := aServerDirectory fileNames. + rawList isString ifTrue: [self inform: 'server is unavailable' translated. ^nothingFound]. + list _ rawList collect: [:nnn | nnn unescapePercents]. + max _ -1. goodName _ nil. - rawList isString ifTrue: [self inform: 'server is unavailable'. ^nothingFound]. - list := rawList collect: [:nnn | nnn unescapePercents]. - max := -1. goodName := nil. list withIndexDo: [:aName :ind | + ((aName beginsWith: stem)) ifTrue: [ + ((aName endsWith: triple last) or: [triple last = '' and: [aName endsWith: '.pr']]) ifTrue: [ + num _ (Project parseProjectFileName: aName) second. + num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]]. - (aName beginsWith: stem) ifTrue: [ - num := (Project parseProjectFileName: aName) second. - num > max ifTrue: [max := num. goodName := (rawList at: ind)]]]. max = -1 ifFalse: [^ Array with: goodName with: max]. "try with underbar for spaces on server" (stem includes: $ ) ifTrue: [ + stem1 _ stem copyReplaceAll: ' ' with: '_'. - stem1 := stem copyReplaceAll: ' ' with: '_'. list withIndexDo: [:aName :ind | (aName beginsWith: stem1) ifTrue: [ + num _ (Project parseProjectFileName: aName) second. + num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]]. - num := (Project parseProjectFileName: aName) second. - num > max ifTrue: [max := num. goodName := (rawList at: ind)]]]]. max = -1 ifFalse: [^ Array with: goodName with: max]. "try without the marker | " + stem1 _ stem allButLast, '.pr'. + stem2 _ stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced" - stem1 := stem allButLast, '.pr'. - stem2 := stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced" list withIndexDo: [:aName :ind | (aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [ + (triple _ aName findTokens: '.') size >= 2 ifTrue: [ + max _ 0. goodName _ (rawList at: ind)]]]. "no other versions" - (triple := aName findTokens: '.') size >= 2 ifTrue: [ - max := 0. goodName := (rawList at: ind)]]]. "no other versions" max = -1 ifFalse: [^ Array with: goodName with: max]. ^nothingFound "no matches" ! Item was changed: ----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') ----- squeakletDirectory | squeakletDirectoryName | + squeakletDirectoryName := SugarLauncher current + parameterAt: 'SQUEAKLETS' + ifAbsent: ['Squeaklets']. - squeakletDirectoryName := 'Squeaklets'. (FileDirectory default directoryExists: squeakletDirectoryName) ifFalse: [ FileDirectory default createDirectory: squeakletDirectoryName ]. ^FileDirectory default directoryNamed: squeakletDirectoryName! Item was changed: ----- Method: Project class>>sweep: (in category 'squeaklet on server') ----- sweep: aServerDirectory | repository list parts ind entry projectName versions | "On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'" "Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone directory: '/vol0/people/dani/Squeaklets/2.7')" "Ensure the 'older' directory" (aServerDirectory includesKey: 'older') ifFalse: [aServerDirectory createDirectory: 'older']. + repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'. - repository := aServerDirectory clone directory: aServerDirectory directory, '/older'. "Collect each name, and decide on versions" + list _ aServerDirectory fileNames. + list isString ifTrue: [^ self inform: 'server is unavailable' translated]. + list _ list asSortedCollection asOrderedCollection. + parts _ list collect: [:en | Project parseProjectFileName: en]. + parts _ parts select: [:en | en third = 'pr']. + ind _ 1. + [entry _ list at: ind. + projectName _ entry first asLowercase. + versions _ OrderedCollection new. versions add: entry. + [(ind _ ind + 1) > list size - list := aServerDirectory fileNames. - list isString ifTrue: [^ self inform: 'server is unavailable']. - list := list asSortedCollection asOrderedCollection. - parts := list collect: [:en | Project parseProjectFileName: en]. - parts := parts select: [:en | en third = 'pr']. - ind := 1. - [entry := list at: ind. - projectName := entry first asLowercase. - versions := OrderedCollection new. versions add: entry. - [(ind := ind + 1) > list size ifFalse: [(parts at: ind) first asLowercase = projectName ifTrue: [versions add: (parts at: ind). true] ifFalse: [false]] ifTrue: [false]] whileTrue. aServerDirectory moveYoungest: 3 in: versions to: repository. ind > list size] whileFalse. ! Item was changed: ----- Method: Project>>depth (in category 'active process') ----- depth "Return the depth of this project from the top. topProject = 0, next = 1, etc." "Project current depth." + | depth project | + depth _ 0. + project _ self. - | depth topProject project | - depth := 0. - topProject := Project topProject. - project := self. + [project class == DiskProxy ifTrue: [^ depth]. + project isTopProject] + whileFalse: + [project _ project parent. + depth _ depth + 1]. - [project ~= topProject and:[project notNil]] - whileTrue: - [project := project parent. - depth := depth + 1]. ^ depth! Item was changed: ----- Method: Project>>doWeWantToRename (in category 'menu messages') ----- doWeWantToRename | want | self hasBadNameForStoring ifTrue: [^true]. + (self name beginsWith: 'Unnamed' translated) ifTrue: [^true]. + want _ world valueOfProperty: #SuperSwikiRename ifAbsent: [false]. - (self name beginsWith: 'Unnamed') ifTrue: [^true]. - want := world valueOfProperty: #SuperSwikiRename ifAbsent: [false]. world removeProperty: #SuperSwikiRename. ^want ! Item was changed: ----- Method: Project>>htmlPagePrototype (in category 'file in/out') ----- htmlPagePrototype "Return the HTML page prototype" ^'<html> <head> <title>Squeak Project</title> <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> </head> <body bgcolor="#FFFFFF"> <EMBED type="application/x-squeak-source" ALIGN="CENTER" WIDTH="$$WIDTH$$" HEIGHT="$$HEIGHT$$" src="$$PROJECT$$" + pluginspage="http://www.squeakland.org/download/"> - pluginspage="http://www.squeakland.org/plugin/detect/detectinstaller.html"> </EMBED> </body> </html> '! Item was changed: ----- Method: Project>>revert (in category 'file in/out') ----- revert | | "Exit this project and do not save it. Warn user unless in dangerous projectRevertNoAsk mode. Exit to the parent project. Do a revert on a clone of the segment, to allow later reverts." + projectParameters ifNil: [^ self inform: 'nothing to revert to' translated]. - projectParameters ifNil: [^ self inform: 'nothing to revert to']. parentProject enter: false revert: true saveForRevert: false. "does not return!!" ! Item was changed: ----- Method: Project>>storeOnServer (in category 'file in/out') ----- storeOnServer "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." world setProperty: #optimumExtentFromAuthor toValue: world extent. + self validateProjectNameIfOK: [:details | + self acceptProjectDetails: details. - self validateProjectNameIfOK: [ self isCurrentProject ifTrue: ["exit, then do the command" ^ self armsLengthCommand: #storeOnServerAssumingNameValid withDescription: 'Publishing' translated ]. self storeOnServerWithProgressInfo. ].! Item was changed: ----- Method: Project>>storeOnServerAssumingNameValid (in category 'file in/out') ----- storeOnServerAssumingNameValid "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." - world setProperty: #optimumExtentFromAuthor toValue: world extent. self isCurrentProject ifTrue: ["exit, then do the command" + Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true]. ^ self armsLengthCommand: #storeOnServerAssumingNameValid withDescription: 'Publishing' translated ]. self storeOnServerWithProgressInfo. ! Item was changed: ----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') ----- storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget "Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded." world setProperty: #optimumExtentFromAuthor toValue: world extent. + self validateProjectNameIfOK: [:details | + self acceptProjectDetails: details. - self validateProjectNameIfOK: [ self isCurrentProject ifTrue: ["exit, then do the command" forget ifTrue: [self forgetExistingURL] ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]]. ^self armsLengthCommand: #storeOnServerAssumingNameValid withDescription: 'Publishing' translated ]. self storeOnServerWithProgressInfoOn: aMorphOrNil. ]. ! Item was changed: ----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') ----- validateProjectNameIfOK: aBlock | details | details := world valueOfProperty: #ProjectDetails. details ifNotNil: ["ensure project info matches real project name" details at: 'projectname' put: self name. ]. + self doWeWantToRename ifFalse: [^ aBlock value: details]. - self doWeWantToRename ifFalse: [^aBlock value]. (Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm | etpdm getFullInfoFor: self + ifValid: [:d | - ifValid: [ World displayWorldSafely. + aBlock value: d - aBlock value. ] expandedFormat: false] ! Item was changed: ----- Method: ProjectLauncher>>loginAs: (in category 'eToy login') ----- loginAs: userName "Assuming that we have a valid user url; read its contents and see if the user is really there." | actualName userList | eToyAuthentificationServer ifNil:[ self proceedWithLogin. ^true]. + userList _ eToyAuthentificationServer eToyUserList. - userList := eToyAuthentificationServer eToyUserList. userList ifNil:[ self inform: 'Sorry, I cannot find the user list. (this may be due to a network problem) + Please hit Cancel if you wish to use Squeak.' translated. - Please hit Cancel if you wish to use Squeak.'. ^false]. "case insensitive search" + actualName _ userList detect:[:any| any sameAs: userName] ifNone:[nil]. - actualName := userList detect:[:any| any sameAs: userName] ifNone:[nil]. actualName isNil ifTrue:[ + self inform: 'Unknown user: ' translated ,userName. - self inform: 'Unknown user: ',userName. ^false]. Utilities authorName: actualName. eToyAuthentificationServer eToyUserName: actualName. self proceedWithLogin. ^true! Item was changed: ----- Method: SARInstaller class>>serviceFileInSAR (in category 'class initialization') ----- serviceFileInSAR "Answer a service for opening a changelist browser on a file" ^ SimpleServiceEntry provider: self + label: 'install SAR' translatedNoop - label: 'install SAR' selector: #installSAR: + description: 'install this Squeak ARchive into the image.' translatedNoop + buttonLabel: 'install' translatedNoop! - description: 'install this Squeak ARchive into the image.' - buttonLabel: 'install'! Item was changed: ----- Method: SystemVersion>>majorMinorVersion (in category 'accessing') ----- majorMinorVersion "Return the major/minor version number of the form X.Y, without any 'alpha' or 'beta' or other suffix." - "(SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion" " --> 'Squeak3.7' " - "SystemVersion current majorMinorVersion" | char stream | + ^ (version includes: $.) + ifTrue: + [stream := ReadStream on: version, 'x'. + stream upTo: $.. + char := stream next. + [char isDigit] + whileTrue: [char := stream next]. + version copyFrom: 1 to: stream position - 1] + ifFalse: + [version] + + " + (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion + (SystemVersion new version: 'Testing') majorMinorVersion + SystemVersion current majorMinorVersion + " + - stream := ReadStream on: version, 'x'. - stream upTo: $.. - char := stream next. - char ifNil: [^ version]. "eg: 'Jasmine-rc1' has no $. in it." - [char isDigit] - whileTrue: [char := stream next]. - ^ version copyFrom: 1 to: stream position - 1 ! Item was changed: ----- Method: TextStyle>>addNewFontSize: (in category '*System-Fonts') ----- addNewFontSize: pointSize "Add a font in specified size to the array of fonts." | f d newArray t isSet | fontArray first emphasis ~= 0 ifTrue: [ t := TextConstants at: self fontArray first familyName asSymbol. t fonts first emphasis = 0 ifTrue: [ ^ t addNewFontSize: pointSize. ]. ]. pointSize <= 0 ifTrue: [^ nil]. fontArray do: [:s | s pointSize = pointSize ifTrue: [^ s]. ]. (isSet := fontArray first isKindOf: TTCFontSet) ifTrue:[ | fonts | fonts := fontArray first fontArray collect: [ :font | | newFont | (font isNil) ifTrue: [newFont := nil] ifFalse: [ newFont := (font ttcDescription size > 256) ifTrue: [MultiTTCFont new initialize] ifFalse: [TTCFont new initialize]. newFont ttcDescription: font ttcDescription. newFont pixelSize: pointSize * 96 // 72. font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto | proto ifNotNil: [ d := proto class new initialize. d ttcDescription: proto ttcDescription. d pixelSize: newFont pixelSize. newFont derivativeFont: d]]]. ]. newFont]. f := TTCFontSet newFontArray: fonts] ifFalse: [ f := fontArray first class new initialize: fontArray first. f pointSize: pointSize. fontArray first derivativeFonts do: [:proto | proto ifNotNil: [ + d := TTCFont new initialize: proto. - d := proto class new initialize: proto. d pointSize: f pointSize. + f derivativeFont: d. - f derivativeFont: d mainFont: proto. ]. ]. ]. newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize]. self newFontArray: newArray. isSet ifTrue: [ TTCFontSet register: newArray at: newArray first familyName asSymbol. ]. ^ self fontOfPointSize: pointSize ! Item was changed: ----- Method: Utilities class>>floatPrecisionForDecimalPlaces: (in category 'miscellaneous') ----- floatPrecisionForDecimalPlaces: places "Answer the floatPrecision that corresponds to the given number of decimal places" ^ places caseOf: {[0]->[1] . + [1]-> [0.1] . + [2]-> [0.01] . + [3]-> [0.001] . + [4]-> [0.0001] . + [5]-> [0.00001] . + [6]-> [0.000001] . + [7]-> [0.0000001] . + [8]-> [0.00000001] . + [9]-> [0.000000001]. + [10]->[0.0000000001]} - [1]->[0.1] . - [2]->[0.01] . - [3]->[0.001] . - [4]->[0.0001] . - [5]->[0.00001] . - [6]->[0.000001] . - [7]->[0.0000001] . - [8]->[0.00000001] . - [9]->[0.000000001]} otherwise: [(10.0 raisedTo: places negated) asFloat] " (0 to: 6) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i] (-10 to: 20) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i] "! Item was changed: ----- Method: Utilities class>>registerInFlapsRegistry (in category 'class initialization') ----- registerInFlapsRegistry "Register the receiver in the system's flaps registry" self environment at: #Flaps + ifPresent: [:cl | cl registerQuad: {#Utilities. #recentSubmissionsWindow. 'Recent' translatedNoop. 'A message browser that tracks the most recently-submitted methods' translatedNoop} - ifPresent: [:cl | cl registerQuad: #(Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') forFlapNamed: 'Tools'.]!

1 0

The Trunk: System-tfel.872.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

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'.]!

1 0

The Trunk: System-tfel.873.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.873.mcz ==================== Summary ==================== Name: System-tfel.873 Author: tfel Time: 8 August 2016, 4:43:15.739129 pm UUID: 58178fcf-779d-ca40-9e8f-a1691a345b98 Ancestors: System-tfel.872 Fix an infinite loop when the locale is changed during startup =============== 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: Locale class>>localeChangedGently (in category 'notification') ----- localeChangedGently + SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].! - self class environment allBehaviorsDo: [:b | b localeChangedGently].! 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'.]!

1 0

The Trunk: System-tfel.877.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.877.mcz ==================== Summary ==================== Name: System-tfel.877 Author: tfel Time: 10 August 2016, 9:45:24.363314 am UUID: 97848dfb-1a63-7148-96dd-6944014677c6 Ancestors: System-cmm.876, System-tfel.873 merge with trunk =============== Diff against System-cmm.876 =============== 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: Locale class>>localeChangedGently (in category 'notification') ----- localeChangedGently + SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].! - self class environment allBehaviorsDo: [:b | b localeChangedGently].! 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'.]!

1 0

The Trunk: System-tfel.882.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.882.mcz ==================== Summary ==================== Name: System-tfel.882 Author: tfel Time: 15 August 2016, 10:49:19.882909 am UUID: 63636ed9-4e42-d14c-a41f-ec8924e8c6e9 Ancestors: System-tfel.880, System-mt.881 - merge with trunk - update DiskProxy>>enter:revert:saveForRevert: with Squeakland code =============== Diff against System-mt.881 =============== 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: DiskProxy>>enter:revert:saveForRevert: (in category 'exceptions') ----- enter: returningFlag revert: revertFlag saveForRevert: saveForRevert "Look for our project on the server, then try to enter it!! DiskProxy is acting as a stub for the real thing. Called from a ProjectViewMorph in the current project. If have url, use it. Else look in current Project's server and folder." + constructorSelector == #namedExample: ifTrue: ["Project namedUrl: xxx" + ^ ((Smalltalk at: globalObjectName) perform: #fromExampleEtoys: + withArguments: constructorArgs) ]. constructorSelector == #namedUrl: ifTrue: ["Project namedUrl: xxx" ^ ((Smalltalk at: globalObjectName) perform: #fromUrl: withArguments: constructorArgs) ]. constructorSelector == #named: ifTrue: [ Project current fromMyServerLoad: constructorArgs first]. "name" ! 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 added: + ----- Method: NaturalLanguageTranslator class>>availableLanguageLocaleIDs (in category 'accessing') ----- + availableLanguageLocaleIDs + "Return the locale ids for the currently available languages. + Meaning those which either internally or externally have + translations available." + "NaturalLanguageTranslator availableLanguageLocaleIDs" + ^ self translators values collect:[:each | each localeID]! 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 added: + ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') ----- + translatedNoop + "This is correspondence gettext_noop() in gettext." + ^ self + ! 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>>useButtonPropertiesToFire (in category 'standard queries') ----- - useButtonPropertiesToFire - ^ self - valueOfFlag: #useButtonProprtiesToFire - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>useFormsInPaintBox (in category 'prefs - misc') ----- - useFormsInPaintBox - - ^ self valueOfFlag: #useFormsInPaintBox! 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 added: + ----- Method: Project class>>publishInSexp (in category 'preferences') ----- + publishInSexp + + Smalltalk at: #SISSDictionaryForScanning ifPresent: [:siss | ^ siss publishInSexp]. + ^ false! Item was changed: ----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') ----- squeakletDirectory | squeakletDirectoryName | + squeakletDirectoryName := (Smalltalk at: #SugarLauncher ifPresent: [:c | + c current parameterAt: 'SQUEAKLETS' ifAbsent: []]) ifNil: ['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 added: + ----- Method: Project>>acceptProjectDetails: (in category 'file in/out') ----- + acceptProjectDetails: details + "Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project." + + world setProperty: #ProjectDetails toValue: details. + details at: 'projectname' ifPresent: [ :newName | + self renameTo: newName]! Item was added: + ----- Method: Project>>compressFilesIn:to:in: (in category 'file in/out') ----- + compressFilesIn: tempDir to: localName in: localDirectory + "Compress all the files in tempDir making up a zip file in localDirectory named localName" + + | archive archiveName entry fileNames | + archive := ZipArchive new. + fileNames := tempDir fileNames. + (fileNames includes: 'manifest') + ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')]. + fileNames do:[:fn| + archiveName := fn. + entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName. + entry desiredCompressionMethod: ( + fn = 'manifest' + ifTrue: [ZipArchive compressionLevelNone] + ifFalse: [ZipArchive compressionDeflated]). + ]. + archive writeToFileNamed: (localDirectory fullNameFor: localName). + archive close. + tempDir fileNames do:[:fn| + tempDir deleteFileNamed: fn ifAbsent:[]]. + localDirectory deleteDirectory: tempDir localName.! Item was added: + ----- Method: Project>>createViewIfAppropriate (in category 'utilities') ----- + createViewIfAppropriate + "overridden in subclasses" + ^ self! 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>>exportSegmentFileName:directory: (in category 'file in/out') ----- exportSegmentFileName: aFileName directory: aDirectory + ^ self exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: false! - | exportChangeSet | - - "An experimental version to fileout a changeSet first so that a project can contain its own classes" - - "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. - Player classes are included automatically." - - exportChangeSet := nil. - (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ - (self confirm: - 'Would you like to include all the changes in the change set - as part of this publishing operation?' translated) ifTrue: [ - exportChangeSet := changeSet - ]. - ]. - ^ self - exportSegmentWithChangeSet: exportChangeSet - fileName: aFileName - directory: aDirectory - ! Item was added: + ----- Method: Project>>exportSegmentFileName:directory:withoutInteraction: (in category 'file in/out') ----- + exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction + + | exportChangeSet | + + "An experimental version to fileout a changeSet first so that a project can contain its own classes" + + "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. + Player classes are included automatically." + exportChangeSet := nil. + (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ + (noInteraction or: [self confirm: + 'Would you like to include all the changes in the change set + as part of this publishing operation?' translated]) ifTrue: [ + exportChangeSet := changeSet + ]. + ]. + + Project publishInSexp ifTrue: [ + ^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction + ]. + ^ self + exportSegmentWithChangeSet: exportChangeSet + fileName: aFileName + directory: aDirectory + withoutInteraction: noInteraction! Item was added: + ----- Method: Project>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') ----- + exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction + + self subclassResponsibility! 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 added: + ----- Method: ProjectLoading class>>checkSecurity:preStream:projStream: (in category 'utilities') ----- + checkSecurity: aFileName preStream: preStream projStream: projStream + "Answer true if passed" + | trusted enterRestricted | + trusted := SecurityManager default positionToSecureContentsOf: + projStream. + trusted ifFalse: + [enterRestricted := (preStream isTypeHTTP or: + [aFileName isNil]) + ifTrue: [Preferences securityChecksEnabled] + ifFalse: [Preferences standaloneSecurityChecksEnabled]. + enterRestricted + ifTrue: [SecurityManager default enterRestrictedMode + ifFalse: + [preStream close. + ^ false]]]. + ^ true! Item was added: + ----- Method: ProjectLoading class>>checkStream: (in category 'utilities') ----- + checkStream: aStream + (aStream isNil + or: [aStream size = 0]) + ifFalse: [^ false]. + ProgressNotification signal: '9999 about to enter + project'. + "the hard part is over" + self inform: 'It looks like a problem occurred while + getting this project. It may be temporary, + so you may want to try again,' translated. + ^ true! Item was added: + ----- Method: ProjectLoading class>>fileInName:archive:morphOrList: (in category 'utilities') ----- + fileInName: aFileName archive: archive morphOrList: morphOrList + | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | + ResourceCollector current: ResourceCollector new. + baseChangeSet := ChangeSet current. + self useTempChangeSet. "named zzTemp" + "The actual reading happens here" + substituteFont := Preferences standardDefaultTextFont copy. + numberOfFontSubstitutes := 0. + exceptions := Set new. + [[anObject := morphOrList fileInObjectAndCodeForProject] + on: MissingFont do: [ :ex | + exceptions add: ex. + numberOfFontSubstitutes := numberOfFontSubstitutes + 1. + ex resume: substituteFont ]] + ensure: [ ChangeSet newChanges: baseChangeSet]. + mgr := ResourceManager new initializeFrom: ResourceCollector current. + mgr fixJISX0208Resource. + mgr registerUnloadedResources. + archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. + ResourceCollector current: nil. + ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! Item was added: + ----- Method: ProjectLoading class>>loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: (in category 'loading') ----- + loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr + + | proj projectsToBeDeleted ef | + Smalltalk at: #Flaps ifPresent: [:flaps | + (flaps globalFlapTabWithID: 'Navigator' translated)ifNotNil: [:f | f hideFlap]]. + proj := morphOrList arrayOfRoots + detect: [:mm | mm isKindOf: Project] + ifNone: [^ nil]. + numberOfFontSubstitutes > 0 ifTrue: [ + proj projectParameterAt: #substitutedFont put: substituteFont]. + ef := proj projectParameterAt: #eToysFont. + (ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [ + proj projectParameterAt: #substitutedFont put: substituteFont. + ]. + proj projectParameters at: #MultiSymbolInWrongPlace put: false. + "Yoshiki did not put MultiSymbols into outPointers in older images!!" + morphOrList arrayOfRoots do: [:obj | + obj fixUponLoad: proj seg: morphOrList "imageSegment"]. + (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ + morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]]. + + proj resourceManager: mgr. + "proj versionFrom: preStream." + proj lastDirectory: aDirectoryOrNil. + proj setParent: Project current. + projectsToBeDeleted := OrderedCollection new. + existingView == #none ifFalse: [ + self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. + ChangeSorter allChangeSets add: proj changeSet. + Project current projectParameters + at: #deleteWhenEnteringNewProject + ifPresent: [ :ignored | + projectsToBeDeleted add: Project current. + Project current removeParameter: #deleteWhenEnteringNewProject. + ]. + projectsToBeDeleted isEmpty ifFalse: [ + proj projectParameters + at: #projectsToBeDeleted + put: projectsToBeDeleted. + ]. + proj removeParameter: #eToysFont. + ^ proj! Item was added: + ----- Method: ProjectLoading class>>makeExistingView:project:projectsToBeDeleted: (in category 'utilities') ----- + makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted + existingView ifNil: [ + proj createViewIfAppropriate. + ChangeSorter allChangeSets add: proj changeSet. + Project current openProject: proj. + ] ifNotNil: [ + (existingView project isKindOf: DiskProxy) ifFalse: [ + existingView project changeSet name: + ChangeSet defaultName. + projectsToBeDeleted add: existingView project. + ]. + (existingView owner isSystemWindow) ifTrue: [ + existingView owner model: proj + ]. + existingView project: proj. + ].! Item was added: + ----- Method: ProjectLoading class>>morphOrList:stream:fromDirectory:archive: (in category 'utilities') ----- + morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive + "Answer morphOrList or nil if problem happened" + | projStream localDir morphOrList | + projStream := archive + ifNil: [preStream] + ifNotNil: [self projectStreamFromArchive: archive]. + (self checkSecurity: aFileName preStream: preStream projStream: projStream) + ifFalse: [^nil]. + localDir := Project squeakletDirectory. + aFileName ifNotNil: [ + (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName + ~= localDir pathName]) ifTrue: [ + localDir deleteFileNamed: aFileName. + (localDir fileNamed: aFileName) binary + nextPutAll: preStream remainingContents; + close. + ]. + ]. + morphOrList := projStream asUnZippedStream. + preStream sleep. "if ftp, let the connection close" + ^ morphOrList! Item was changed: ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView: (in category 'loading') ----- openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView - "Reconstitute a Morph from the selected file, presumed to be - represent a Morph saved via the SmartRefStream mechanism, and open it - in an appropriate Morphic world." + ^ self openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil + withProjectView: existingView clearOriginFlag: false.! - | morphOrList proj trusted localDir projStream archive mgr - projectsToBeDeleted baseChangeSet enterRestricted substituteFont - numberOfFontSubstitutes exceptions | - (preStream isNil or: [preStream size = 0]) ifTrue: [ - ProgressNotification signal: '9999 about to enter - project'. "the hard part is over" - ^self inform: - 'It looks like a problem occurred while - getting this project. It may be temporary, - so you may want to try again,' translated - ]. - ProgressNotification signal: '2:fileSizeDetermined - ',preStream size printString. - preStream isZipArchive - ifTrue:[ archive := ZipArchive new readFrom: preStream. - projStream := self - projectStreamFromArchive: archive] - ifFalse:[projStream := preStream]. - trusted := SecurityManager default positionToSecureContentsOf: - projStream. - trusted ifFalse: - [enterRestricted := (preStream isTypeHTTP or: - [aFileName isNil]) - ifTrue: [Preferences securityChecksEnabled] - ifFalse: [Preferences standaloneSecurityChecksEnabled]. - enterRestricted - ifTrue: [SecurityManager default enterRestrictedMode - ifFalse: - [preStream close. - ^ self]]]. - - localDir := Project squeakletDirectory. - aFileName ifNotNil: [ - (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName - ~= localDir pathName]) ifTrue: [ - localDir deleteFileNamed: aFileName. - (localDir fileNamed: aFileName) binary - nextPutAll: preStream contents; - close. - ]. - ]. - morphOrList := projStream asUnZippedStream. - preStream sleep. "if ftp, let the connection close" - ProgressNotification signal: '3:unzipped'. - ResourceCollector current: ResourceCollector new. - baseChangeSet := ChangeSet current. - self useTempChangeSet. "named zzTemp" - "The actual reading happens here" - substituteFont := Preferences standardEToysFont copy. - numberOfFontSubstitutes := 0. - exceptions := Set new. - [[morphOrList := morphOrList fileInObjectAndCodeForProject] - on: MissingFont do: [ :ex | - exceptions add: ex. - numberOfFontSubstitutes := - numberOfFontSubstitutes + 1. - ex resume: substituteFont ]] - ensure: [ ChangeSet newChanges: baseChangeSet]. - mgr := ResourceManager new initializeFrom: ResourceCollector current. - mgr fixJISX0208Resource. - mgr registerUnloadedResources. - archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: - aFileName]. - (preStream respondsTo: #close) ifTrue:[preStream close]. - ResourceCollector current: nil. - ProgressNotification signal: '4:filedIn'. - ProgressNotification signal: '9999 about to enter project'. - "the hard part is over" - (morphOrList isKindOf: ImageSegment) ifTrue: [ - proj := morphOrList arrayOfRoots - detect: [:mm | mm isKindOf: Project] - ifNone: [^self inform: 'No project found in - this file']. - proj projectParameters at: #substitutedFont put: ( - numberOfFontSubstitutes > 0 - ifTrue: [substituteFont] - ifFalse: [#none]). - proj projectParameters at: #MultiSymbolInWrongPlace put: false. - "Yoshiki did not put MultiSymbols into - outPointers in older images!!" - morphOrList arrayOfRoots do: [:obj | - obj fixUponLoad: proj seg: morphOrList "imageSegment"]. - (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ - morphOrList arrayOfRoots do: [:obj | (obj - isKindOf: HashedCollection) ifTrue: [obj rehash]]]. - - proj resourceManager: mgr. - "proj versionFrom: preStream." - proj lastDirectory: aDirectoryOrNil. - proj setParent: Project current. - projectsToBeDeleted := OrderedCollection new. - existingView ifNil: [ - ChangeSet allChangeSets add: proj changeSet. - Project current openProject: proj. - "Note: in MVC we get no further than the above" - ] ifNotNil: [ - (existingView project isKindOf: DiskProxy) ifFalse: [ - existingView project changeSet name: - ChangeSet defaultName. - projectsToBeDeleted add: existingView project. - ]. - (existingView owner isSystemWindow) ifTrue: [ - existingView owner model: proj - ]. - existingView project: proj. - ]. - ChangeSet allChangeSets add: proj changeSet. - Project current projectParameters - at: #deleteWhenEnteringNewProject - ifPresent: [ :ignored | - projectsToBeDeleted add: Project current. - Project current removeParameter: - #deleteWhenEnteringNewProject. - ]. - projectsToBeDeleted isEmpty ifFalse: [ - proj projectParameters - at: #projectsToBeDeleted - put: projectsToBeDeleted. - ]. - ^ ProjectEntryNotification signal: proj - ]. - Project current openViewAndEnter: morphOrList - ! Item was added: + ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category 'loading') ----- + openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil + withProjectView: existingView clearOriginFlag: clearOriginFlag + "Reconstitute a Morph from the selected file, presumed to + represent a Morph saved via the SmartRefStream mechanism, and open it + in an appropriate Morphic world." + + | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | + (self checkStream: preStream) ifTrue: [^ self]. + ProgressNotification signal: '0.2'. + archive _ preStream isZipArchive + ifTrue:[ZipArchive new readFrom: preStream] + ifFalse:[nil]. + archive ifNotNil:[ + manifests _ (archive membersMatching: '*manifest'). + (manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) + ifTrue: [ + ^ (self respondsTo: #openSexpProjectDict:stream:fromDirectory:withProjectView:) + ifTrue: [self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView] + ifFalse: [self inform: 'Cannot load S-Expression format projects without Etoys' translated]]]. + + morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. + morphOrList ifNil: [^ self]. + ProgressNotification signal: '0.4'. + resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList. + anObject _ resultArray first. + numberOfFontSubstitutes _ resultArray second. + substituteFont _ resultArray third. + mgr _ resultArray fourth. + preStream close. + ProgressNotification signal: '0.7'. + "the hard part is over" + (anObject isKindOf: ImageSegment) ifTrue: [ + project _ self loadImageSegment: anObject + fromDirectory: aDirectoryOrNil + withProjectView: existingView + numberOfFontSubstitutes: numberOfFontSubstitutes + substituteFont: substituteFont + mgr: mgr. + project noteManifestDetailsIn: dict. + project removeParameter: #sugarProperties. + Smalltalk at: #SugarPropertiesNotification ifPresent: [:sp | + sp signal ifNotNilDo: [:props | + project keepSugarProperties: props monitor: true]]. + clearOriginFlag ifTrue: [project forgetExistingURL]. + ProgressNotification signal: '0.8'. + ^ project + ifNil: [self inform: 'No project found in this file' translated] + ifNotNil: [ProjectEntryNotification signal: project]]. + Project current openViewAndEnter: anObject! Item was added: + ----- Method: ProjectLoading class>>parseManifest: (in category 'utilities') ----- + parseManifest: aString + + | dict line index key value aStream | + aStream := aString readStream. + dict := Dictionary new. + [(line := aStream nextLine) notNil] whileTrue: [ + index := line indexOf: $:. + index > 0 ifTrue: [ + key := line copyFrom: 1 to: index - 1. + value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. + dict at: key put: value. + ]. + ]. + ^ dict.! Item was changed: ----- Method: ProjectLoading class>>projectStreamFromArchive: (in category 'accessing') ----- projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. + prFiles isEmpty ifTrue: + [ext := FileDirectory dot, 'sexp'. + prFiles := archive members select:[:any| any fileName endsWith: ext]]. + prFiles isEmpty ifTrue: ['']. - prFiles isEmpty ifTrue:[^'']. entry := prFiles first. + unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). - unzipped := RWBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! 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'.]!

1 0

The Trunk: System-tfel.879.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.879.mcz ==================== Summary ==================== Name: System-tfel.879 Author: tfel Time: 10 August 2016, 10:41:58.514848 am UUID: 626dfc61-8ec1-9f40-84ad-112abc56d755 Ancestors: System-tfel.878 remove direct reference to Etoys =============== Diff against System-cmm.876 =============== 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: Locale class>>localeChangedGently (in category 'notification') ----- localeChangedGently + SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].! - self class environment allBehaviorsDo: [:b | b localeChangedGently].! 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 added: + ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') ----- + translatedNoop + "This is correspondence gettext_noop() in gettext." + ^ self + ! 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 := (Smalltalk at: #SugarLauncher ifPresent: [:c | + c current parameterAt: 'SQUEAKLETS' ifAbsent: []]) ifNil: ['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'.]!

1 0

The Trunk: System-tfel.878.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.878.mcz ==================== Summary ==================== Name: System-tfel.878 Author: tfel Time: 10 August 2016, 9:51:41.662314 am UUID: 70c58675-7950-f044-892b-4195c4eb4dd6 Ancestors: System-tfel.877 add Object>>translatedNoop as catch-all for localization =============== Diff against System-cmm.876 =============== 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: Locale class>>localeChangedGently (in category 'notification') ----- localeChangedGently + SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].! - self class environment allBehaviorsDo: [:b | b localeChangedGently].! 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 added: + ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') ----- + translatedNoop + "This is correspondence gettext_noop() in gettext." + ^ self + ! 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'.]!

1 0

The Trunk: System-tfel.880.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.880.mcz ==================== Summary ==================== Name: System-tfel.880 Author: tfel Time: 10 August 2016, 3:25:06.212665 pm UUID: 8363ffbe-86d8-a54f-811e-07a91aeb6a61 Ancestors: System-tfel.879 Import Etoys and SISS independent bits for storing and loading images also from sexps from the Squeakland release. Mostly this just refactors the Project loading code into multiple different methods, but it also puts the junctions in there to save and load SISS SExpressions rather than image segments, if SISS and Etoys are loaded =============== Diff against System-cmm.876 =============== 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: Locale class>>localeChangedGently (in category 'notification') ----- localeChangedGently + SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].! - self class environment allBehaviorsDo: [:b | b localeChangedGently].! 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 added: + ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') ----- + translatedNoop + "This is correspondence gettext_noop() in gettext." + ^ self + ! 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 added: + ----- Method: Project class>>publishInSexp (in category 'preferences') ----- + publishInSexp + + Smalltalk at: #SISSDictionaryForScanning ifPresent: [:siss | ^ siss publishInSexp]. + ^ false + ! Item was changed: ----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') ----- squeakletDirectory | squeakletDirectoryName | + squeakletDirectoryName := (Smalltalk at: #SugarLauncher ifPresent: [:c | + c current parameterAt: 'SQUEAKLETS' ifAbsent: []]) ifNil: ['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 added: + ----- Method: Project>>acceptProjectDetails: (in category 'file in/out') ----- + acceptProjectDetails: details + "Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project." + + world setProperty: #ProjectDetails toValue: details. + details at: 'projectname' ifPresent: [ :newName | + self renameTo: newName]! Item was added: + ----- Method: Project>>compressFilesIn:to:in: (in category 'file in/out') ----- + compressFilesIn: tempDir to: localName in: localDirectory + "Compress all the files in tempDir making up a zip file in localDirectory named localName" + + | archive archiveName entry fileNames | + archive := ZipArchive new. + fileNames := tempDir fileNames. + (fileNames includes: 'manifest') + ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')]. + fileNames do:[:fn| + archiveName := fn. + entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName. + entry desiredCompressionMethod: ( + fn = 'manifest' + ifTrue: [ZipArchive compressionLevelNone] + ifFalse: [ZipArchive compressionDeflated]). + ]. + archive writeToFileNamed: (localDirectory fullNameFor: localName). + archive close. + tempDir fileNames do:[:fn| + tempDir deleteFileNamed: fn ifAbsent:[]]. + localDirectory deleteDirectory: tempDir localName.! Item was added: + ----- Method: Project>>createViewIfAppropriate (in category 'utilities') ----- + createViewIfAppropriate + "overridden in subclasses" + ^ self! 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>>exportSegmentFileName:directory: (in category 'file in/out') ----- exportSegmentFileName: aFileName directory: aDirectory + ^ self exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: false! - | exportChangeSet | - - "An experimental version to fileout a changeSet first so that a project can contain its own classes" - - "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. - Player classes are included automatically." - - exportChangeSet := nil. - (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ - (self confirm: - 'Would you like to include all the changes in the change set - as part of this publishing operation?' translated) ifTrue: [ - exportChangeSet := changeSet - ]. - ]. - ^ self - exportSegmentWithChangeSet: exportChangeSet - fileName: aFileName - directory: aDirectory - ! Item was added: + ----- Method: Project>>exportSegmentFileName:directory:withoutInteraction: (in category 'file in/out') ----- + exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction + + | exportChangeSet | + + "An experimental version to fileout a changeSet first so that a project can contain its own classes" + + "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. + Player classes are included automatically." + exportChangeSet := nil. + (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ + (noInteraction or: [self confirm: + 'Would you like to include all the changes in the change set + as part of this publishing operation?' translated]) ifTrue: [ + exportChangeSet := changeSet + ]. + ]. + + Project publishInSexp ifTrue: [ + ^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction + ]. + ^ self + exportSegmentWithChangeSet: exportChangeSet + fileName: aFileName + directory: aDirectory + withoutInteraction: noInteraction + ! Item was added: + ----- Method: Project>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') ----- + exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction + + self subclassResponsibility! 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 added: + ----- Method: ProjectLoading class>>checkSecurity:preStream:projStream: (in category 'utilities') ----- + checkSecurity: aFileName preStream: preStream projStream: projStream + "Answer true if passed" + | trusted enterRestricted | + trusted := SecurityManager default positionToSecureContentsOf: + projStream. + trusted ifFalse: + [enterRestricted := (preStream isTypeHTTP or: + [aFileName isNil]) + ifTrue: [Preferences securityChecksEnabled] + ifFalse: [Preferences standaloneSecurityChecksEnabled]. + enterRestricted + ifTrue: [SecurityManager default enterRestrictedMode + ifFalse: + [preStream close. + ^ false]]]. + ^ true + ! Item was added: + ----- Method: ProjectLoading class>>checkStream: (in category 'utilities') ----- + checkStream: aStream + (aStream isNil + or: [aStream size = 0]) + ifFalse: [^ false]. + ProgressNotification signal: '9999 about to enter + project'. + "the hard part is over" + self inform: 'It looks like a problem occurred while + getting this project. It may be temporary, + so you may want to try again,' translated. + ^ true! Item was added: + ----- Method: ProjectLoading class>>fileInName:archive:morphOrList: (in category 'utilities') ----- + fileInName: aFileName archive: archive morphOrList: morphOrList + | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | + ResourceCollector current: ResourceCollector new. + baseChangeSet := ChangeSet current. + self useTempChangeSet. "named zzTemp" + "The actual reading happens here" + substituteFont := Preferences standardDefaultTextFont copy. + numberOfFontSubstitutes := 0. + exceptions := Set new. + [[anObject := morphOrList fileInObjectAndCodeForProject] + on: MissingFont do: [ :ex | + exceptions add: ex. + numberOfFontSubstitutes := numberOfFontSubstitutes + 1. + ex resume: substituteFont ]] + ensure: [ ChangeSet newChanges: baseChangeSet]. + mgr := ResourceManager new initializeFrom: ResourceCollector current. + mgr fixJISX0208Resource. + mgr registerUnloadedResources. + archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. + ResourceCollector current: nil. + ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! Item was added: + ----- Method: ProjectLoading class>>loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: (in category 'loading') ----- + loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr + + | proj projectsToBeDeleted ef | + Smalltalk at: #Flaps ifPresent: [:flaps | + (flaps globalFlapTabWithID: 'Navigator' translated)ifNotNil: [:f | f hideFlap]]. + proj := morphOrList arrayOfRoots + detect: [:mm | mm isKindOf: Project] + ifNone: [^ nil]. + numberOfFontSubstitutes > 0 ifTrue: [ + proj projectParameterAt: #substitutedFont put: substituteFont]. + ef := proj projectParameterAt: #eToysFont. + (ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [ + proj projectParameterAt: #substitutedFont put: substituteFont. + ]. + proj projectParameters at: #MultiSymbolInWrongPlace put: false. + "Yoshiki did not put MultiSymbols into outPointers in older images!!" + morphOrList arrayOfRoots do: [:obj | + obj fixUponLoad: proj seg: morphOrList "imageSegment"]. + (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ + morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]]. + + proj resourceManager: mgr. + "proj versionFrom: preStream." + proj lastDirectory: aDirectoryOrNil. + proj setParent: Project current. + projectsToBeDeleted := OrderedCollection new. + existingView == #none ifFalse: [ + self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. + ChangeSorter allChangeSets add: proj changeSet. + Project current projectParameters + at: #deleteWhenEnteringNewProject + ifPresent: [ :ignored | + projectsToBeDeleted add: Project current. + Project current removeParameter: #deleteWhenEnteringNewProject. + ]. + projectsToBeDeleted isEmpty ifFalse: [ + proj projectParameters + at: #projectsToBeDeleted + put: projectsToBeDeleted. + ]. + proj removeParameter: #eToysFont. + ^ proj! Item was added: + ----- Method: ProjectLoading class>>makeExistingView:project:projectsToBeDeleted: (in category 'utilities') ----- + makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted + existingView ifNil: [ + proj createViewIfAppropriate. + ChangeSorter allChangeSets add: proj changeSet. + Project current openProject: proj. + ] ifNotNil: [ + (existingView project isKindOf: DiskProxy) ifFalse: [ + existingView project changeSet name: + ChangeSet defaultName. + projectsToBeDeleted add: existingView project. + ]. + (existingView owner isSystemWindow) ifTrue: [ + existingView owner model: proj + ]. + existingView project: proj. + ]. + ! Item was added: + ----- Method: ProjectLoading class>>morphOrList:stream:fromDirectory:archive: (in category 'utilities') ----- + morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive + "Answer morphOrList or nil if problem happened" + | projStream localDir morphOrList | + projStream := archive + ifNil: [preStream] + ifNotNil: [self projectStreamFromArchive: archive]. + (self checkSecurity: aFileName preStream: preStream projStream: projStream) + ifFalse: [^nil]. + localDir := Project squeakletDirectory. + aFileName ifNotNil: [ + (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName + ~= localDir pathName]) ifTrue: [ + localDir deleteFileNamed: aFileName. + (localDir fileNamed: aFileName) binary + nextPutAll: preStream remainingContents; + close. + ]. + ]. + morphOrList := projStream asUnZippedStream. + preStream sleep. "if ftp, let the connection close" + ^ morphOrList + ! Item was changed: ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView: (in category 'loading') ----- openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView - "Reconstitute a Morph from the selected file, presumed to be - represent a Morph saved via the SmartRefStream mechanism, and open it - in an appropriate Morphic world." + ^ self openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil + withProjectView: existingView clearOriginFlag: false. - | morphOrList proj trusted localDir projStream archive mgr - projectsToBeDeleted baseChangeSet enterRestricted substituteFont - numberOfFontSubstitutes exceptions | - (preStream isNil or: [preStream size = 0]) ifTrue: [ - ProgressNotification signal: '9999 about to enter - project'. "the hard part is over" - ^self inform: - 'It looks like a problem occurred while - getting this project. It may be temporary, - so you may want to try again,' translated - ]. - ProgressNotification signal: '2:fileSizeDetermined - ',preStream size printString. - preStream isZipArchive - ifTrue:[ archive := ZipArchive new readFrom: preStream. - projStream := self - projectStreamFromArchive: archive] - ifFalse:[projStream := preStream]. - trusted := SecurityManager default positionToSecureContentsOf: - projStream. - trusted ifFalse: - [enterRestricted := (preStream isTypeHTTP or: - [aFileName isNil]) - ifTrue: [Preferences securityChecksEnabled] - ifFalse: [Preferences standaloneSecurityChecksEnabled]. - enterRestricted - ifTrue: [SecurityManager default enterRestrictedMode - ifFalse: - [preStream close. - ^ self]]]. - localDir := Project squeakletDirectory. - aFileName ifNotNil: [ - (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName - ~= localDir pathName]) ifTrue: [ - localDir deleteFileNamed: aFileName. - (localDir fileNamed: aFileName) binary - nextPutAll: preStream contents; - close. - ]. - ]. - morphOrList := projStream asUnZippedStream. - preStream sleep. "if ftp, let the connection close" - ProgressNotification signal: '3:unzipped'. - ResourceCollector current: ResourceCollector new. - baseChangeSet := ChangeSet current. - self useTempChangeSet. "named zzTemp" - "The actual reading happens here" - substituteFont := Preferences standardEToysFont copy. - numberOfFontSubstitutes := 0. - exceptions := Set new. - [[morphOrList := morphOrList fileInObjectAndCodeForProject] - on: MissingFont do: [ :ex | - exceptions add: ex. - numberOfFontSubstitutes := - numberOfFontSubstitutes + 1. - ex resume: substituteFont ]] - ensure: [ ChangeSet newChanges: baseChangeSet]. - mgr := ResourceManager new initializeFrom: ResourceCollector current. - mgr fixJISX0208Resource. - mgr registerUnloadedResources. - archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: - aFileName]. - (preStream respondsTo: #close) ifTrue:[preStream close]. - ResourceCollector current: nil. - ProgressNotification signal: '4:filedIn'. - ProgressNotification signal: '9999 about to enter project'. - "the hard part is over" - (morphOrList isKindOf: ImageSegment) ifTrue: [ - proj := morphOrList arrayOfRoots - detect: [:mm | mm isKindOf: Project] - ifNone: [^self inform: 'No project found in - this file']. - proj projectParameters at: #substitutedFont put: ( - numberOfFontSubstitutes > 0 - ifTrue: [substituteFont] - ifFalse: [#none]). - proj projectParameters at: #MultiSymbolInWrongPlace put: false. - "Yoshiki did not put MultiSymbols into - outPointers in older images!!" - morphOrList arrayOfRoots do: [:obj | - obj fixUponLoad: proj seg: morphOrList "imageSegment"]. - (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ - morphOrList arrayOfRoots do: [:obj | (obj - isKindOf: HashedCollection) ifTrue: [obj rehash]]]. - - proj resourceManager: mgr. - "proj versionFrom: preStream." - proj lastDirectory: aDirectoryOrNil. - proj setParent: Project current. - projectsToBeDeleted := OrderedCollection new. - existingView ifNil: [ - ChangeSet allChangeSets add: proj changeSet. - Project current openProject: proj. - "Note: in MVC we get no further than the above" - ] ifNotNil: [ - (existingView project isKindOf: DiskProxy) ifFalse: [ - existingView project changeSet name: - ChangeSet defaultName. - projectsToBeDeleted add: existingView project. - ]. - (existingView owner isSystemWindow) ifTrue: [ - existingView owner model: proj - ]. - existingView project: proj. - ]. - ChangeSet allChangeSets add: proj changeSet. - Project current projectParameters - at: #deleteWhenEnteringNewProject - ifPresent: [ :ignored | - projectsToBeDeleted add: Project current. - Project current removeParameter: - #deleteWhenEnteringNewProject. - ]. - projectsToBeDeleted isEmpty ifFalse: [ - proj projectParameters - at: #projectsToBeDeleted - put: projectsToBeDeleted. - ]. - ^ ProjectEntryNotification signal: proj - ]. - Project current openViewAndEnter: morphOrList ! Item was added: + ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category 'loading') ----- + openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil + withProjectView: existingView clearOriginFlag: clearOriginFlag + "Reconstitute a Morph from the selected file, presumed to + represent a Morph saved via the SmartRefStream mechanism, and open it + in an appropriate Morphic world." + + | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | + (self checkStream: preStream) ifTrue: [^ self]. + ProgressNotification signal: '0.2'. + archive _ preStream isZipArchive + ifTrue:[ZipArchive new readFrom: preStream] + ifFalse:[nil]. + archive ifNotNil:[ + manifests _ (archive membersMatching: '*manifest'). + (manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) + ifTrue: [ + ^ (self respondsTo: #openSexpProjectDict:stream:fromDirectory:withProjectView:) + ifTrue: [self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView] + ifFalse: [self inform: 'Cannot load S-Expression format projects without Etoys' translated]]]. + + morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. + morphOrList ifNil: [^ self]. + ProgressNotification signal: '0.4'. + resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList. + anObject _ resultArray first. + numberOfFontSubstitutes _ resultArray second. + substituteFont _ resultArray third. + mgr _ resultArray fourth. + preStream close. + ProgressNotification signal: '0.7'. + "the hard part is over" + (anObject isKindOf: ImageSegment) ifTrue: [ + project _ self loadImageSegment: anObject + fromDirectory: aDirectoryOrNil + withProjectView: existingView + numberOfFontSubstitutes: numberOfFontSubstitutes + substituteFont: substituteFont + mgr: mgr. + project noteManifestDetailsIn: dict. + project removeParameter: #sugarProperties. + Smalltalk at: #SugarPropertiesNotification ifPresent: [:sp | + sp signal ifNotNilDo: [:props | + project keepSugarProperties: props monitor: true]]. + clearOriginFlag ifTrue: [project forgetExistingURL]. + ProgressNotification signal: '0.8'. + ^ project + ifNil: [self inform: 'No project found in this file' translated] + ifNotNil: [ProjectEntryNotification signal: project]]. + Project current openViewAndEnter: anObject! Item was added: + ----- Method: ProjectLoading class>>parseManifest: (in category 'utilities') ----- + parseManifest: aString + + | dict line index key value aStream | + aStream := aString readStream. + dict := Dictionary new. + [(line := aStream nextLine) notNil] whileTrue: [ + index := line indexOf: $:. + index > 0 ifTrue: [ + key := line copyFrom: 1 to: index - 1. + value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. + dict at: key put: value. + ]. + ]. + ^ dict.! Item was changed: ----- Method: ProjectLoading class>>projectStreamFromArchive: (in category 'accessing') ----- projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. + prFiles isEmpty ifTrue: + [ext := FileDirectory dot, 'sexp'. + prFiles := archive members select:[:any| any fileName endsWith: ext]]. + prFiles isEmpty ifTrue: ['']. - prFiles isEmpty ifTrue:[^'']. entry := prFiles first. + unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). - unzipped := RWBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! 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'.]!

1 0

The Trunk: System-tfel.902.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tfel.902.mcz ==================== Summary ==================== Name: System-tfel.902 Author: tfel Time: 21 August 2016, 4:49:50.260391 pm UUID: 3646f16c-8148-4f44-92df-000c079b45dd Ancestors: System-mt.901, System-tfel.882 merge trunk =============== Diff against System-mt.901 =============== 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: DiskProxy>>enter:revert:saveForRevert: (in category 'exceptions') ----- enter: returningFlag revert: revertFlag saveForRevert: saveForRevert "Look for our project on the server, then try to enter it!! DiskProxy is acting as a stub for the real thing. Called from a ProjectViewMorph in the current project. If have url, use it. Else look in current Project's server and folder." + constructorSelector == #namedExample: ifTrue: ["Project namedUrl: xxx" + ^ ((Smalltalk at: globalObjectName) perform: #fromExampleEtoys: + withArguments: constructorArgs) ]. constructorSelector == #namedUrl: ifTrue: ["Project namedUrl: xxx" ^ ((Smalltalk at: globalObjectName) perform: #fromUrl: withArguments: constructorArgs) ]. constructorSelector == #named: ifTrue: [ Project current fromMyServerLoad: constructorArgs first]. "name" ! 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>>availableLanguageLocaleIDs (in category 'accessing') ----- availableLanguageLocaleIDs "Return the locale ids for the currently available languages. Meaning those which either internally or externally have translations available." "NaturalLanguageTranslator availableLanguageLocaleIDs" ^ self translators values collect:[:each | each localeID]! 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 added: + ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') ----- + translatedNoop + "This is correspondence gettext_noop() in gettext." + ^ self + ! 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 added: + ----- Method: Preferences class>>allowCelesteTell (in category 'standard queries') ----- + allowCelesteTell + ^ self + valueOfFlag: #allowCelesteTell + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>allowEtoyUserCustomEvents (in category 'standard queries') ----- + allowEtoyUserCustomEvents + ^ self + valueOfFlag: #allowEtoyUserCustomEvents + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>alternativeScrollbarLook (in category 'standard queries') ----- + alternativeScrollbarLook + ^ self + valueOfFlag: #alternativeScrollbarLook + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>alternativeWindowLook (in category 'standard queries') ----- + alternativeWindowLook + ^ self + valueOfFlag: #alternativeWindowLook + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>ansiAssignmentOperatorWhenPrettyPrinting (in category 'standard queries') ----- + ansiAssignmentOperatorWhenPrettyPrinting + ^ self + valueOfFlag: #ansiAssignmentOperatorWhenPrettyPrinting + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>autoAccessors (in category 'standard queries') ----- + autoAccessors + ^ self + valueOfFlag: #autoAccessors + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>biggerCursors (in category 'standard queries') ----- + biggerCursors + ^ self + valueOfFlag: #biggerCursors + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>blinkParen (in category 'standard queries') ----- + blinkParen + ^ self + valueOfFlag: #blinkParen + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>browseWithDragNDrop (in category 'standard queries') ----- + browseWithDragNDrop + ^ self + valueOfFlag: #browseWithDragNDrop + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>browseWithPrettyPrint (in category 'standard queries') ----- + browseWithPrettyPrint + ^ self + valueOfFlag: #browseWithPrettyPrint + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>browserNagIfNoClassComment (in category 'standard queries') ----- + browserNagIfNoClassComment + ^ self + valueOfFlag: #browserNagIfNoClassComment + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>browserShowsPackagePane (in category 'standard queries') ----- + browserShowsPackagePane + ^ self + valueOfFlag: #browserShowsPackagePane + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>canRecordWhilePlaying (in category 'standard queries') ----- + canRecordWhilePlaying + ^ self + valueOfFlag: #canRecordWhilePlaying + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>celesteHasStatusPane (in category 'standard queries') ----- + celesteHasStatusPane + ^ self + valueOfFlag: #celesteHasStatusPane + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>celesteShowsAttachmentsFlag (in category 'standard queries') ----- + celesteShowsAttachmentsFlag + ^ self + valueOfFlag: #celesteShowsAttachmentsFlag + 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 added: + ----- Method: Preferences class>>classicNewMorphMenu (in category 'standard queries') ----- + classicNewMorphMenu + ^ self + valueOfFlag: #classicNewMorphMenu + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>colorWhenPrettyPrinting (in category 'standard queries') ----- + colorWhenPrettyPrinting + ^ self + valueOfFlag: #colorWhenPrettyPrinting + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>cpuWatcherEnabled (in category 'standard queries') ----- + cpuWatcherEnabled + ^ self + valueOfFlag: #cpuWatcherEnabled + ifAbsent: [false]! Item was changed: ----- Method: Preferences class>>debugLogTimestamp (in category 'standard queries') ----- debugLogTimestamp ^ self valueOfFlag: #debugLogTimestamp ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>dismissEventTheatreUponPublish (in category 'standard queries') ----- + dismissEventTheatreUponPublish + ^ self + valueOfFlag: #dismissEventTheatreUponPublish + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>enableInternetConfig (in category 'standard queries') ----- + enableInternetConfig + ^ self + valueOfFlag: #enableInternetConfig + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>enablePortraitMode (in category 'standard queries') ----- + enablePortraitMode + ^ self + valueOfFlag: #enablePortraitMode + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>enableVirtualOLPCDisplay (in category 'standard queries') ----- + enableVirtualOLPCDisplay + ^ self + valueOfFlag: #enableVirtualOLPCDisplay + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>escapeKeyProducesMenu (in category 'standard queries') ----- + escapeKeyProducesMenu + ^ self + valueOfFlag: #escapeKeyProducesMenu + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>gradientMenu (in category 'standard queries') ----- + gradientMenu + ^ self + valueOfFlag: #gradientMenu + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>gradientScrollBars (in category 'standard queries') ----- + gradientScrollBars + ^ self + valueOfFlag: #gradientScrollBars + ifAbsent: [true]! Item was changed: + ----- Method: Preferences class>>haloTheme (in category 'standard queries') ----- - ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') ----- haloTheme ^ self valueOfFlag: #haloTheme + ifAbsent: [#iconicHaloSpecifications]! - 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 added: + ----- Method: Preferences class>>ignoreStyleIfOnlyBold (in category 'standard queries') ----- + ignoreStyleIfOnlyBold + ^ self + valueOfFlag: #ignoreStyleIfOnlyBold + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>implicitSelfInTiles (in category 'standard queries') ----- + implicitSelfInTiles + ^ self + valueOfFlag: #implicitSelfInTiles + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>inboardScrollbars (in category 'standard queries') ----- + inboardScrollbars + ^ self + valueOfFlag: #inboardScrollbars + ifAbsent: [true]! 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 added: + ----- Method: Preferences class>>morphicProgressStyle (in category 'standard queries') ----- + morphicProgressStyle + ^ self + valueOfFlag: #morphicProgressStyle + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>preserveTrash (in category 'standard queries') ----- + preserveTrash + ^ self + valueOfFlag: #preserveTrash + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>printAlternateSyntax (in category 'standard queries') ----- + printAlternateSyntax + ^ self + valueOfFlag: #printAlternateSyntax + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>promptForUpdateServer (in category 'standard queries') ----- + promptForUpdateServer + ^ self + valueOfFlag: #promptForUpdateServer + ifAbsent: [false]! 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 added: + ----- Method: Preferences class>>rotationAndScaleHandlesInPaintBox (in category 'standard queries') ----- + rotationAndScaleHandlesInPaintBox + ^ self + valueOfFlag: #rotationAndScaleHandlesInPaintBox + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>roundedMenuCorners (in category 'standard queries') ----- + roundedMenuCorners + ^ self + valueOfFlag: #roundedMenuCorners + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>roundedScrollBarLook (in category 'standard queries') ----- + roundedScrollBarLook + ^ self + valueOfFlag: #roundedScrollBarLook + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>roundedWindowCorners (in category 'standard queries') ----- + roundedWindowCorners + ^ self + valueOfFlag: #roundedWindowCorners + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>scrollBarsWithoutMenuButton (in category 'standard queries') ----- + scrollBarsWithoutMenuButton + ^ self + valueOfFlag: #scrollBarsWithoutMenuButton + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>selectionsMayShrink (in category 'standard queries') ----- + selectionsMayShrink + ^ self + valueOfFlag: #selectionsMayShrink + ifAbsent: [true]! Item was changed: ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') ----- showAdvancedNavigatorButtons ^ self valueOfFlag: #showAdvancedNavigatorButtons + ifAbsent: [false]! - ifAbsent: [ true ]! Item was added: + ----- Method: Preferences class>>showDeprecationWarnings (in category 'standard queries') ----- + showDeprecationWarnings + ^ self + valueOfFlag: #showDeprecationWarnings + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>showLinesInHierarchyViews (in category 'standard queries') ----- + showLinesInHierarchyViews + ^ self + valueOfFlag: #showLinesInHierarchyViews + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>slideDismissalsToTrash (in category 'standard queries') ----- + slideDismissalsToTrash + ^ self + valueOfFlag: #slideDismissalsToTrash + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>soundQuickStart (in category 'standard queries') ----- + soundQuickStart + ^ self + valueOfFlag: #soundQuickStart + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>soundReverb (in category 'standard queries') ----- + soundReverb + ^ self + valueOfFlag: #soundReverb + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>soundStopWhenDone (in category 'standard queries') ----- + soundStopWhenDone + ^ self + valueOfFlag: #soundStopWhenDone + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>soundsEnabled (in category 'standard queries') ----- + soundsEnabled + ^ self + valueOfFlag: #soundsEnabled + 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 added: + ----- Method: Preferences class>>sugarAutoSave (in category 'standard queries') ----- + sugarAutoSave + ^ self + valueOfFlag: #sugarAutoSave + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>testRunnerShowAbstractClasses (in category 'standard queries') ----- + testRunnerShowAbstractClasses + ^ self + valueOfFlag: #testRunnerShowAbstractClasses + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>twoSidedPoohTextures (in category 'standard queries') ----- + twoSidedPoohTextures + ^ self + valueOfFlag: #twoSidedPoohTextures + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>unifyNestedProgressBars (in category 'standard queries') ----- + unifyNestedProgressBars + ^ self + valueOfFlag: #unifyNestedProgressBars + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>updateFromServerAtStartup (in category 'standard queries') ----- + updateFromServerAtStartup + ^ self + valueOfFlag: #updateFromServerAtStartup + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>updateSavesFile (in category 'standard queries') ----- + updateSavesFile + ^ self + valueOfFlag: #updateSavesFile + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>useArtificialSweetenerBar (in category 'standard queries') ----- + useArtificialSweetenerBar + ^ self + valueOfFlag: #useArtificialSweetenerBar + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>useBiggerPaintingBox (in category 'standard queries') ----- + useBiggerPaintingBox + ^ self + valueOfFlag: #useBiggerPaintingBox + ifAbsent: [true]! Item was changed: ----- Method: Preferences class>>useButtonPropertiesToFire (in category 'standard queries') ----- useButtonPropertiesToFire ^ self + valueOfFlag: #useButtonPropertiesToFire + ifAbsent: [false]! - valueOfFlag: #useButtonProprtiesToFire - ifAbsent: [ false ]! Item was added: + ----- Method: Preferences class>>useFileList2 (in category 'standard queries') ----- + useFileList2 + ^ self + valueOfFlag: #useFileList2 + ifAbsent: [true]! Item was changed: + ----- Method: Preferences class>>useFormsInPaintBox (in category 'standard queries') ----- - ----- Method: Preferences class>>useFormsInPaintBox (in category 'prefs - misc') ----- useFormsInPaintBox + ^ self + valueOfFlag: #useFormsInPaintBox + ifAbsent: [false]! - - ^ self valueOfFlag: #useFormsInPaintBox! Item was added: + ----- Method: Preferences class>>usePangoRenderer (in category 'standard queries') ----- + usePangoRenderer + ^ self + valueOfFlag: #usePangoRenderer + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>usePlatformFonts (in category 'standard queries') ----- + usePlatformFonts + ^ self + valueOfFlag: #usePlatformFonts + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>usePopUpArrows (in category 'standard queries') ----- + usePopUpArrows + ^ self + valueOfFlag: #usePopUpArrows + ifAbsent: [true]! Item was added: + ----- Method: Preferences class>>warnIfChangesFileReadOnly (in category 'standard queries') ----- + warnIfChangesFileReadOnly + ^ self + valueOfFlag: #warnIfChangesFileReadOnly + ifAbsent: [false]! Item was added: + ----- Method: Preferences class>>warningForMacOSFileNameLength (in category 'standard queries') ----- + warningForMacOSFileNameLength + ^ self + valueOfFlag: #warningForMacOSFileNameLength + 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 added: + ----- Method: Project class>>publishInSexp (in category 'preferences') ----- + publishInSexp + + Smalltalk at: #SISSDictionaryForScanning ifPresent: [:siss | ^ siss publishInSexp]. + ^ false! Item was changed: ----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') ----- squeakletDirectory | squeakletDirectoryName | + squeakletDirectoryName := (Smalltalk at: #SugarLauncher ifPresent: [:c | + c current parameterAt: 'SQUEAKLETS' ifAbsent: []]) ifNil: ['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 added: + ----- Method: Project>>acceptProjectDetails: (in category 'file in/out') ----- + acceptProjectDetails: details + "Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project." + + world setProperty: #ProjectDetails toValue: details. + details at: 'projectname' ifPresent: [ :newName | + self renameTo: newName]! Item was added: + ----- Method: Project>>compressFilesIn:to:in: (in category 'file in/out') ----- + compressFilesIn: tempDir to: localName in: localDirectory + "Compress all the files in tempDir making up a zip file in localDirectory named localName" + + | archive archiveName entry fileNames | + archive := ZipArchive new. + fileNames := tempDir fileNames. + (fileNames includes: 'manifest') + ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')]. + fileNames do:[:fn| + archiveName := fn. + entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName. + entry desiredCompressionMethod: ( + fn = 'manifest' + ifTrue: [ZipArchive compressionLevelNone] + ifFalse: [ZipArchive compressionDeflated]). + ]. + archive writeToFileNamed: (localDirectory fullNameFor: localName). + archive close. + tempDir fileNames do:[:fn| + tempDir deleteFileNamed: fn ifAbsent:[]]. + localDirectory deleteDirectory: tempDir localName.! Item was added: + ----- Method: Project>>createViewIfAppropriate (in category 'utilities') ----- + createViewIfAppropriate + "overridden in subclasses" + ^ self! 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>>exportSegmentFileName:directory: (in category 'file in/out') ----- exportSegmentFileName: aFileName directory: aDirectory + ^ self exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: false! - | exportChangeSet | - - "An experimental version to fileout a changeSet first so that a project can contain its own classes" - - "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. - Player classes are included automatically." - - exportChangeSet := nil. - (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ - (self confirm: - 'Would you like to include all the changes in the change set - as part of this publishing operation?' translated) ifTrue: [ - exportChangeSet := changeSet - ]. - ]. - ^ self - exportSegmentWithChangeSet: exportChangeSet - fileName: aFileName - directory: aDirectory - ! Item was added: + ----- Method: Project>>exportSegmentFileName:directory:withoutInteraction: (in category 'file in/out') ----- + exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction + + | exportChangeSet | + + "An experimental version to fileout a changeSet first so that a project can contain its own classes" + + "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg. + Player classes are included automatically." + exportChangeSet := nil. + (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [ + (noInteraction or: [self confirm: + 'Would you like to include all the changes in the change set + as part of this publishing operation?' translated]) ifTrue: [ + exportChangeSet := changeSet + ]. + ]. + + Project publishInSexp ifTrue: [ + ^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction + ]. + ^ self + exportSegmentWithChangeSet: exportChangeSet + fileName: aFileName + directory: aDirectory + withoutInteraction: noInteraction! Item was added: + ----- Method: Project>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') ----- + exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction + + self subclassResponsibility! 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 added: + ----- Method: ProjectLoading class>>checkSecurity:preStream:projStream: (in category 'utilities') ----- + checkSecurity: aFileName preStream: preStream projStream: projStream + "Answer true if passed" + | trusted enterRestricted | + trusted := SecurityManager default positionToSecureContentsOf: + projStream. + trusted ifFalse: + [enterRestricted := (preStream isTypeHTTP or: + [aFileName isNil]) + ifTrue: [Preferences securityChecksEnabled] + ifFalse: [Preferences standaloneSecurityChecksEnabled]. + enterRestricted + ifTrue: [SecurityManager default enterRestrictedMode + ifFalse: + [preStream close. + ^ false]]]. + ^ true! Item was added: + ----- Method: ProjectLoading class>>checkStream: (in category 'utilities') ----- + checkStream: aStream + (aStream isNil + or: [aStream size = 0]) + ifFalse: [^ false]. + ProgressNotification signal: '9999 about to enter + project'. + "the hard part is over" + self inform: 'It looks like a problem occurred while + getting this project. It may be temporary, + so you may want to try again,' translated. + ^ true! Item was added: + ----- Method: ProjectLoading class>>fileInName:archive:morphOrList: (in category 'utilities') ----- + fileInName: aFileName archive: archive morphOrList: morphOrList + | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr | + ResourceCollector current: ResourceCollector new. + baseChangeSet := ChangeSet current. + self useTempChangeSet. "named zzTemp" + "The actual reading happens here" + substituteFont := Preferences standardDefaultTextFont copy. + numberOfFontSubstitutes := 0. + exceptions := Set new. + [[anObject := morphOrList fileInObjectAndCodeForProject] + on: MissingFont do: [ :ex | + exceptions add: ex. + numberOfFontSubstitutes := numberOfFontSubstitutes + 1. + ex resume: substituteFont ]] + ensure: [ ChangeSet newChanges: baseChangeSet]. + mgr := ResourceManager new initializeFrom: ResourceCollector current. + mgr fixJISX0208Resource. + mgr registerUnloadedResources. + archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName]. + ResourceCollector current: nil. + ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}! Item was added: + ----- Method: ProjectLoading class>>loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: (in category 'loading') ----- + loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr + + | proj projectsToBeDeleted ef | + Smalltalk at: #Flaps ifPresent: [:flaps | + (flaps globalFlapTabWithID: 'Navigator' translated)ifNotNil: [:f | f hideFlap]]. + proj := morphOrList arrayOfRoots + detect: [:mm | mm isKindOf: Project] + ifNone: [^ nil]. + numberOfFontSubstitutes > 0 ifTrue: [ + proj projectParameterAt: #substitutedFont put: substituteFont]. + ef := proj projectParameterAt: #eToysFont. + (ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [ + proj projectParameterAt: #substitutedFont put: substituteFont. + ]. + proj projectParameters at: #MultiSymbolInWrongPlace put: false. + "Yoshiki did not put MultiSymbols into outPointers in older images!!" + morphOrList arrayOfRoots do: [:obj | + obj fixUponLoad: proj seg: morphOrList "imageSegment"]. + (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ + morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]]. + + proj resourceManager: mgr. + "proj versionFrom: preStream." + proj lastDirectory: aDirectoryOrNil. + proj setParent: Project current. + projectsToBeDeleted := OrderedCollection new. + existingView == #none ifFalse: [ + self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted]. + ChangeSorter allChangeSets add: proj changeSet. + Project current projectParameters + at: #deleteWhenEnteringNewProject + ifPresent: [ :ignored | + projectsToBeDeleted add: Project current. + Project current removeParameter: #deleteWhenEnteringNewProject. + ]. + projectsToBeDeleted isEmpty ifFalse: [ + proj projectParameters + at: #projectsToBeDeleted + put: projectsToBeDeleted. + ]. + proj removeParameter: #eToysFont. + ^ proj! Item was added: + ----- Method: ProjectLoading class>>makeExistingView:project:projectsToBeDeleted: (in category 'utilities') ----- + makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted + existingView ifNil: [ + proj createViewIfAppropriate. + ChangeSorter allChangeSets add: proj changeSet. + Project current openProject: proj. + ] ifNotNil: [ + (existingView project isKindOf: DiskProxy) ifFalse: [ + existingView project changeSet name: + ChangeSet defaultName. + projectsToBeDeleted add: existingView project. + ]. + (existingView owner isSystemWindow) ifTrue: [ + existingView owner model: proj + ]. + existingView project: proj. + ].! Item was added: + ----- Method: ProjectLoading class>>morphOrList:stream:fromDirectory:archive: (in category 'utilities') ----- + morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive + "Answer morphOrList or nil if problem happened" + | projStream localDir morphOrList | + projStream := archive + ifNil: [preStream] + ifNotNil: [self projectStreamFromArchive: archive]. + (self checkSecurity: aFileName preStream: preStream projStream: projStream) + ifFalse: [^nil]. + localDir := Project squeakletDirectory. + aFileName ifNotNil: [ + (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName + ~= localDir pathName]) ifTrue: [ + localDir deleteFileNamed: aFileName. + (localDir fileNamed: aFileName) binary + nextPutAll: preStream remainingContents; + close. + ]. + ]. + morphOrList := projStream asUnZippedStream. + preStream sleep. "if ftp, let the connection close" + ^ morphOrList! Item was changed: ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView: (in category 'loading') ----- openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView - "Reconstitute a Morph from the selected file, presumed to be - represent a Morph saved via the SmartRefStream mechanism, and open it - in an appropriate Morphic world." + ^ self openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil + withProjectView: existingView clearOriginFlag: false.! - | morphOrList proj trusted localDir projStream archive mgr - projectsToBeDeleted baseChangeSet enterRestricted substituteFont - numberOfFontSubstitutes exceptions | - (preStream isNil or: [preStream size = 0]) ifTrue: [ - ProgressNotification signal: '9999 about to enter - project'. "the hard part is over" - ^self inform: - 'It looks like a problem occurred while - getting this project. It may be temporary, - so you may want to try again,' translated - ]. - ProgressNotification signal: '2:fileSizeDetermined - ',preStream size printString. - preStream isZipArchive - ifTrue:[ archive := ZipArchive new readFrom: preStream. - projStream := self - projectStreamFromArchive: archive] - ifFalse:[projStream := preStream]. - trusted := SecurityManager default positionToSecureContentsOf: - projStream. - trusted ifFalse: - [enterRestricted := (preStream isTypeHTTP or: - [aFileName isNil]) - ifTrue: [Preferences securityChecksEnabled] - ifFalse: [Preferences standaloneSecurityChecksEnabled]. - enterRestricted - ifTrue: [SecurityManager default enterRestrictedMode - ifFalse: - [preStream close. - ^ self]]]. - - localDir := Project squeakletDirectory. - aFileName ifNotNil: [ - (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName - ~= localDir pathName]) ifTrue: [ - localDir deleteFileNamed: aFileName. - (localDir fileNamed: aFileName) binary - nextPutAll: preStream contents; - close. - ]. - ]. - morphOrList := projStream asUnZippedStream. - preStream sleep. "if ftp, let the connection close" - ProgressNotification signal: '3:unzipped'. - ResourceCollector current: ResourceCollector new. - baseChangeSet := ChangeSet current. - self useTempChangeSet. "named zzTemp" - "The actual reading happens here" - substituteFont := Preferences standardEToysFont copy. - numberOfFontSubstitutes := 0. - exceptions := Set new. - [[morphOrList := morphOrList fileInObjectAndCodeForProject] - on: MissingFont do: [ :ex | - exceptions add: ex. - numberOfFontSubstitutes := - numberOfFontSubstitutes + 1. - ex resume: substituteFont ]] - ensure: [ ChangeSet newChanges: baseChangeSet]. - mgr := ResourceManager new initializeFrom: ResourceCollector current. - mgr fixJISX0208Resource. - mgr registerUnloadedResources. - archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: - aFileName]. - (preStream respondsTo: #close) ifTrue:[preStream close]. - ResourceCollector current: nil. - ProgressNotification signal: '4:filedIn'. - ProgressNotification signal: '9999 about to enter project'. - "the hard part is over" - (morphOrList isKindOf: ImageSegment) ifTrue: [ - proj := morphOrList arrayOfRoots - detect: [:mm | mm isKindOf: Project] - ifNone: [^self inform: 'No project found in - this file']. - proj projectParameters at: #substitutedFont put: ( - numberOfFontSubstitutes > 0 - ifTrue: [substituteFont] - ifFalse: [#none]). - proj projectParameters at: #MultiSymbolInWrongPlace put: false. - "Yoshiki did not put MultiSymbols into - outPointers in older images!!" - morphOrList arrayOfRoots do: [:obj | - obj fixUponLoad: proj seg: morphOrList "imageSegment"]. - (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [ - morphOrList arrayOfRoots do: [:obj | (obj - isKindOf: HashedCollection) ifTrue: [obj rehash]]]. - - proj resourceManager: mgr. - "proj versionFrom: preStream." - proj lastDirectory: aDirectoryOrNil. - proj setParent: Project current. - projectsToBeDeleted := OrderedCollection new. - existingView ifNil: [ - ChangeSet allChangeSets add: proj changeSet. - Project current openProject: proj. - "Note: in MVC we get no further than the above" - ] ifNotNil: [ - (existingView project isKindOf: DiskProxy) ifFalse: [ - existingView project changeSet name: - ChangeSet defaultName. - projectsToBeDeleted add: existingView project. - ]. - (existingView owner isSystemWindow) ifTrue: [ - existingView owner model: proj - ]. - existingView project: proj. - ]. - ChangeSet allChangeSets add: proj changeSet. - Project current projectParameters - at: #deleteWhenEnteringNewProject - ifPresent: [ :ignored | - projectsToBeDeleted add: Project current. - Project current removeParameter: - #deleteWhenEnteringNewProject. - ]. - projectsToBeDeleted isEmpty ifFalse: [ - proj projectParameters - at: #projectsToBeDeleted - put: projectsToBeDeleted. - ]. - ^ ProjectEntryNotification signal: proj - ]. - Project current openViewAndEnter: morphOrList - ! Item was added: + ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category 'loading') ----- + openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil + withProjectView: existingView clearOriginFlag: clearOriginFlag + "Reconstitute a Morph from the selected file, presumed to + represent a Morph saved via the SmartRefStream mechanism, and open it + in an appropriate Morphic world." + + | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict | + (self checkStream: preStream) ifTrue: [^ self]. + ProgressNotification signal: '0.2'. + archive _ preStream isZipArchive + ifTrue:[ZipArchive new readFrom: preStream] + ifFalse:[nil]. + archive ifNotNil:[ + manifests _ (archive membersMatching: '*manifest'). + (manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression']) + ifTrue: [ + ^ (self respondsTo: #openSexpProjectDict:stream:fromDirectory:withProjectView:) + ifTrue: [self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView] + ifFalse: [self inform: 'Cannot load S-Expression format projects without Etoys' translated]]]. + + morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive. + morphOrList ifNil: [^ self]. + ProgressNotification signal: '0.4'. + resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList. + anObject _ resultArray first. + numberOfFontSubstitutes _ resultArray second. + substituteFont _ resultArray third. + mgr _ resultArray fourth. + preStream close. + ProgressNotification signal: '0.7'. + "the hard part is over" + (anObject isKindOf: ImageSegment) ifTrue: [ + project _ self loadImageSegment: anObject + fromDirectory: aDirectoryOrNil + withProjectView: existingView + numberOfFontSubstitutes: numberOfFontSubstitutes + substituteFont: substituteFont + mgr: mgr. + project noteManifestDetailsIn: dict. + project removeParameter: #sugarProperties. + Smalltalk at: #SugarPropertiesNotification ifPresent: [:sp | + sp signal ifNotNilDo: [:props | + project keepSugarProperties: props monitor: true]]. + clearOriginFlag ifTrue: [project forgetExistingURL]. + ProgressNotification signal: '0.8'. + ^ project + ifNil: [self inform: 'No project found in this file' translated] + ifNotNil: [ProjectEntryNotification signal: project]]. + Project current openViewAndEnter: anObject! Item was added: + ----- Method: ProjectLoading class>>parseManifest: (in category 'utilities') ----- + parseManifest: aString + + | dict line index key value aStream | + aStream := aString readStream. + dict := Dictionary new. + [(line := aStream nextLine) notNil] whileTrue: [ + index := line indexOf: $:. + index > 0 ifTrue: [ + key := line copyFrom: 1 to: index - 1. + value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed. + dict at: key put: value. + ]. + ]. + ^ dict.! Item was changed: ----- Method: ProjectLoading class>>projectStreamFromArchive: (in category 'accessing') ----- projectStreamFromArchive: archive | ext prFiles entry unzipped | ext := FileDirectory dot, Project projectExtension. prFiles := archive members select:[:any| any fileName endsWith: ext]. + prFiles isEmpty ifTrue: + [ext := FileDirectory dot, 'sexp'. + prFiles := archive members select:[:any| any fileName endsWith: ext]]. + prFiles isEmpty ifTrue: ['']. - prFiles isEmpty ifTrue:[^'']. entry := prFiles first. + unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). - unzipped := RWBinaryOrTextStream on: (ByteArray new: entry uncompressedSize). entry extractTo: unzipped. ^unzipped reset! 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: SqueakTheme class>>addSyntaxHighlighting: (in category 'instance creation') ----- addSyntaxHighlighting: theme + "This was the former sub-dued highlighting." - "This was the former sub-dued highlighting. - self create apply. - " theme + set: #color for: #TextAction to: (Color r: 0.4 g: 0.0 b: 1); - set: #color for: #TextAction to: Color aqua; set: #default for: #SHTextStylerST80 to: {Color black}; set: #invalid for: #SHTextStylerST80 to: {Color red}; set: #excessCode for: #SHTextStylerST80 to: {Color red}; set: #comment for: #SHTextStylerST80 to: {Color cyan muchDarker}; set: #unfinishedComment for: #SHTextStylerST80 to: {Color red muchDarker. TextEmphasis italic}; set: #'$' for: #SHTextStylerST80 to: {Color red muchDarker}; set: #character for: #SHTextStylerST80 to: {Color red muchDarker}; set: #integer for: #SHTextStylerST80 to: {Color red muchDarker}; set: #number for: #SHTextStylerST80 to: {Color red muchDarker}; set: #- for: #SHTextStylerST80 to: {Color red muchDarker}; set: #symbol for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #stringSymbol for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #literalArray for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #string for: #SHTextStylerST80 to: {Color magenta muchDarker. TextEmphasis normal}; set: #unfinishedString for: #SHTextStylerST80 to: {Color red. TextEmphasis normal}; set: #assignment for: #SHTextStylerST80 to: {nil. TextEmphasis bold}; set: #ansiAssignment for: #SHTextStylerST80 to: {nil. TextEmphasis bold}; set: #literal for: #SHTextStylerST80 to: {nil. TextEmphasis italic}; set: #keyword for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #binary for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #unary for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #incompleteKeyword for: #SHTextStylerST80 to: {Color gray muchDarker. TextEmphasis underlined}; set: #incompleteBinary for: #SHTextStylerST80 to: {Color gray muchDarker. TextEmphasis underlined}; set: #incompleteUnary for: #SHTextStylerST80 to: {Color gray muchDarker. TextEmphasis underlined}; set: #undefinedKeyword for: #SHTextStylerST80 to: {Color red}; set: #undefinedBinary for: #SHTextStylerST80 to: {Color red}; set: #undefinedUnary for: #SHTextStylerST80 to: {Color red}; set: #patternKeyword for: #SHTextStylerST80 to: {nil. TextEmphasis bold}; set: #patternBinary for: #SHTextStylerST80 to: {nil. TextEmphasis bold}; set: #patternUnary for: #SHTextStylerST80 to: {nil. TextEmphasis bold}; set: #self for: #SHTextStylerST80 to: {Color red muchDarker}; set: #super for: #SHTextStylerST80 to: {Color red muchDarker}; set: #true for: #SHTextStylerST80 to: {Color red muchDarker}; set: #false for: #SHTextStylerST80 to: {Color red muchDarker}; set: #nil for: #SHTextStylerST80 to: {Color red muchDarker}; set: #thisContext for: #SHTextStylerST80 to: {Color red muchDarker}; set: #return for: #SHTextStylerST80 to: {Color red muchDarker}; set: #patternArg for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #methodArg for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #blockPatternArg for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #blockArg for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #argument for: #SHTextStylerST80 to: {Color blue muchDarker}; set: #blockArgColon for: #SHTextStylerST80 to: {Color black}; set: #leftParenthesis for: #SHTextStylerST80 to: {Color black}; set: #rightParenthesis for: #SHTextStylerST80 to: {Color black}; set: #leftParenthesis1 for: #SHTextStylerST80 to: {Color green muchDarker}; set: #rightParenthesis1 for: #SHTextStylerST80 to: {Color green muchDarker}; set: #leftParenthesis2 for: #SHTextStylerST80 to: {Color magenta muchDarker}; set: #rightParenthesis2 for: #SHTextStylerST80 to: {Color magenta muchDarker}; set: #leftParenthesis3 for: #SHTextStylerST80 to: {Color red muchDarker}; set: #rightParenthesis3 for: #SHTextStylerST80 to: {Color red muchDarker}; set: #leftParenthesis4 for: #SHTextStylerST80 to: {Color green darker}; set: #rightParenthesis4 for: #SHTextStylerST80 to: {Color green darker}; set: #leftParenthesis5 for: #SHTextStylerST80 to: {Color orange darker}; set: #rightParenthesis5 for: #SHTextStylerST80 to: {Color orange darker}; set: #leftParenthesis6 for: #SHTextStylerST80 to: {Color magenta darker}; set: #rightParenthesis6 for: #SHTextStylerST80 to: {Color magenta darker}; set: #leftParenthesis7 for: #SHTextStylerST80 to: {Color blue}; set: #rightParenthesis7 for: #SHTextStylerST80 to: {Color blue}; set: #blockStart for: #SHTextStylerST80 to: {Color black}; set: #blockEnd for: #SHTextStylerST80 to: {Color black}; set: #blockStart1 for: #SHTextStylerST80 to: {Color green muchDarker}; set: #blockEnd1 for: #SHTextStylerST80 to: {Color green muchDarker}; set: #blockStart2 for: #SHTextStylerST80 to: {Color magenta muchDarker}; set: #blockEnd2 for: #SHTextStylerST80 to: {Color magenta muchDarker}; set: #blockStart3 for: #SHTextStylerST80 to: {Color red muchDarker}; set: #blockEnd3 for: #SHTextStylerST80 to: {Color red muchDarker}; set: #blockStart4 for: #SHTextStylerST80 to: {Color green darker}; set: #blockEnd4 for: #SHTextStylerST80 to: {Color green darker}; set: #blockStart5 for: #SHTextStylerST80 to: {Color orange darker}; set: #blockEnd5 for: #SHTextStylerST80 to: {Color orange darker}; set: #blockStart6 for: #SHTextStylerST80 to: {Color magenta darker}; set: #blockEnd6 for: #SHTextStylerST80 to: {Color magenta darker}; set: #blockStart7 for: #SHTextStylerST80 to: {Color blue}; set: #blockEnd7 for: #SHTextStylerST80 to: {Color blue}; set: #arrayStart for: #SHTextStylerST80 to: {Color black}; set: #arrayEnd for: #SHTextStylerST80 to: {Color black}; set: #arrayStart1 for: #SHTextStylerST80 to: {Color black}; set: #arrayEnd1 for: #SHTextStylerST80 to: {Color black}; set: #byteArrayStart for: #SHTextStylerST80 to: {Color black}; set: #byteArrayEnd for: #SHTextStylerST80 to: {Color black}; set: #byteArrayStart1 for: #SHTextStylerST80 to: {Color black}; set: #byteArrayEnd1 for: #SHTextStylerST80 to: {Color black}; set: #leftBrace for: #SHTextStylerST80 to: {Color black}; set: #rightBrace for: #SHTextStylerST80 to: {Color black}; set: #cascadeSeparator for: #SHTextStylerST80 to: {Color black}; set: #statementSeparator for: #SHTextStylerST80 to: {Color black}; set: #externalCallType for: #SHTextStylerST80 to: {Color black}; set: #externalCallTypePointerIndicator for: #SHTextStylerST80 to: {Color black}; set: #primitiveOrExternalCallStart for: #SHTextStylerST80 to: {Color black}; set: #primitiveOrExternalCallEnd for: #SHTextStylerST80 to: {Color black}; set: #methodTempBar for: #SHTextStylerST80 to: {Color gray}; set: #blockTempBar for: #SHTextStylerST80 to: {Color gray}; set: #blockArgsBar for: #SHTextStylerST80 to: {Color gray}; set: #primitive for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold}; set: #pragmaKeyword for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold}; set: #pragmaUnary for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold}; set: #pragmaBinary for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold}; set: #externalFunctionCallingConvention for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold}; set: #module for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold}; set: #blockTempVar for: #SHTextStylerST80 to: {Color gray}; set: #blockPatternTempVar for: #SHTextStylerST80 to: {Color gray}; set: #instVar for: #SHTextStylerST80 to: {Color black}; set: #workspaceVar for: #SHTextStylerST80 to: {Color black}; set: #undefinedIdentifier for: #SHTextStylerST80 to: {Color red}; set: #incompleteIdentifier for: #SHTextStylerST80 to: {Color gray darker. {TextEmphasis italic. TextEmphasis underlined}}; set: #tempVar for: #SHTextStylerST80 to: {Color gray darker}; set: #patternTempVar for: #SHTextStylerST80 to: {Color gray darker}; set: #poolConstant for: #SHTextStylerST80 to: {Color gray muchDarker}; set: #classVar for: #SHTextStylerST80 to: {Color gray muchDarker}; set: #globalVar for: #SHTextStylerST80 to: {Color black}. "And the text differ" theme set: #insertTextAttributes for: #TextDiffBuilder to: { TextColor red }; set: #removeTextAttributes for: #TextDiffBuilder to: { TextEmphasis struckOut. TextColor blue }; set: #normalTextAttributes for: #TextDiffBuilder to: { TextEmphasis normal }.! 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'.]!

1 0

The Trunk: GetText-tfel.39.mcz
by commits＠source.squeak.org 31 Aug '16

31 Aug '16

Tim Felgentreff uploaded a new version of GetText to project The Trunk: http://source.squeak.org/trunk/GetText-tfel.39.mcz ==================== Summary ==================== Name: GetText-tfel.39 Author: tfel Time: 2 August 2016, 9:59:04.817368 am UUID: 1c4dcc9f-f48d-4540-a046-9a63874b83c8 Ancestors: GetText-ul.38, GetText-bf.16 merge from Squeakland Etoys image =============== Diff against GetText-ul.38 =============== Item was changed: ----- Method: GetTextExporter>>createExtraInformation (in category 'private') ----- createExtraInformation | extras | extras := OrderedCollection new. #( + 'ATTENTION TRANSLATORS!! This should be the name of your language as you would like it to appear in the Languages menu, e.g. "Español" or "English"' 'Language-Name' + 'ATTENTION TRANSLATORS!! Put in the directionality of your language, that is "LTR" for left-to-right or "RTL" for right-to-left' 'Language-Direction' - 'Language name as you''d like it to appear in the Languages menu' 'Language-Name' - 'Directionality of language' 'Language-Direction' ) pairsDo: [:first :second | extras add: (Array with: '' with: first with: second). ]. ^ extras!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
61
Older →

Jump to page: