The Trunk: System-tfel.902.mcz
Locked
 
|
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'.]! |
«
Return to Squeak - Dev
|
1 view|%1 views
| Free forum by Nabble | Edit this page |