[Pkg] The Trunk: System-tfel.902.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Aug 31 09:21:18 UTC 2016
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'.]!
More information about the Packages
mailing list