Packages August 2022

packages@lists.squeakfoundation.org

1 participants
47 discussions

The Treated Inbox: System-cmm.1145.mcz
by commits＠source.squeak.org 31 Aug '22

31 Aug '22

Chris Muller uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-cmm.1145.mcz ==================== Summary ==================== Name: System-cmm.1145 Author: cmm Time: 31 August 2022, 5:29:41.772761 pm UUID: 358fe212-44c9-44d5-bcdb-f07739ed4735 Ancestors: System-cmm.1144 testing on new server. ignore =============== Diff against System-mt.1142 =============== Item was changed: ----- Method: CommunityTheme class>>addDarkScrollables: (in category 'instance creation') ----- addDarkScrollables: aUserInterfaceTheme "self createDark apply." "Scroll bars" aUserInterfaceTheme set: #thumbColor for: #ScrollBar to: self dbGray; set: #thumbBorderColor for: #ScrollBar to: self dbGray twiceDarker. "Scroll panes (includes generic stuff for list widgets, tree widgets, and text widgets." aUserInterfaceTheme set: #borderColor for: #ScrollPane to: (Color transparent) ; "So the search box isn't outlined." set: #color for: #ScrollPane to: self dbBackground. "List widgets" aUserInterfaceTheme set: #textColor for: #PluggableListMorph to: (Color gray: 0.9); set: #selectionColor for: #PluggableListMorph to: self dbSelection; set: #selectionTextColor for: #PluggableListMorph to: Color white ; derive: #multiSelectionColor for: #PluggableListMorph from: #PluggableListMorph at: #selectionColor do: [:c | c twiceDarker]; set: #filterColor for: #PluggableListMorph to: (self dbYellow alpha: 0.4); derive: #filterTextColor for: #PluggableListMorph from: #PluggableListMorph at: #textColor ; set: #preSelectionModifier for: #PluggableListMorph to: [ [:c | c twiceDarker ] ]; set: #hoverSelectionModifier for: #PluggableListMorph to: [ [:c | c twiceDarker alpha: 0.5 ] ]. "Tree widgets" aUserInterfaceTheme set: #highlightTextColor for: #SimpleHierarchicalListMorph to: self dbYellow lighter lighter; set: #lineColor for: #SimpleHierarchicalListMorph to: Color gray. "Text widgets" aUserInterfaceTheme set: #textColor for: #PluggableTextMorph to: (Color gray: 0.9); set: #caretColor for: #PluggableTextMorph to: Color orange darker; set: #selectionColor for: #PluggableTextMorph to: (self dbSelection duller duller); set: #unfocusedSelectionModifier for: #PluggableTextMorph to: [ [:c | c duller] ]; set: #adornmentReadOnly for: #PluggableTextMorph to: self dbPurple; set: #adornmentRefuse for: #PluggableTextMorph to: self dbBlue; set: #adornmentConflict for: #PluggableTextMorph to: self dbRed; set: #adornmentDiff for: #PluggableTextMorph to: self dbGreen; set: #adornmentNormalEdit for: #PluggableTextMorph to: self dbOrange; set: #adornmentDiffEdit for: #PluggableTextMorph to: self dbYellow; set: #frameAdornmentWidth for: #PluggableTextMorph to: 2. aUserInterfaceTheme + set: #balloonTextColor for: #PluggableTextMorphPlus to: self dbComment! - set: #balloonTextColor for: #PluggableTextMorphPlus to: Color lightGray! Item was changed: ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn') ----- comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal receiverClasses rootsToUnhiberhate myProject existing forgetDoItsClass endianness | forgetDoItsClass := Set new. RecentlyRenamedClasses := nil. "in case old data hanging around" mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." self fixCapitalizationOfSymbols. endianness := self endianness. segment := self loadSegmentFrom: segment outPointers: outPointers. arrayOfRoots := segment first. mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing := TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses := self restoreEndianness: endianness ~~ Smalltalk endianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. rootsToUnhiberhate := OrderedCollection new. arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: ScriptEditorMorph) or: [(importedObject isKindOf: TileMorph) or: [(importedObject isMemberOf: ScriptingTileHolder) or: [importedObject isKindOf: CompoundTileMorph]]]) ifTrue: [ rootsToUnhiberhate add: importedObject ]. (importedObject isMemberOf: Project) ifTrue: [ myProject := importedObject. importedObject ensureChangeSetNameUnique. Project addingProject: importedObject. importedObject restoreReferences. self dependentsRestore: importedObject. ScriptEditorMorph writingUniversalTiles: ((importedObject projectPreferenceAt: #universalTiles) ifNil: [false])]]. myProject ifNotNil: [ myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate asArray. ]. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal | aFake removeFromSystemUnlogged. aFake becomeForward: aReal]. SystemOrganization removeEmptyCategories]. + forgetDoItsClass do: [:c | c forgetDoIts]. - forgetDoItsClass do: [:c | self forgetDoItsInClass: c]. "^ self" ! Item was removed: - ----- Method: ImageSegment>>forgetDoItsInClass: (in category 'private') ----- - forgetDoItsInClass: aClass - "get rid of old DoIt methods and bogus entries in the ClassOrganizer." - - SystemChangeNotifier uniqueInstance doSilently: [ - aClass organization - removeElement: #DoIt; - removeElement: #DoItIn:. - ]. - - aClass - basicRemoveSelector: #DoIt; - basicRemoveSelector: #DoItIn:! Item was changed: ----- Method: Locale class>>defaultInputInterpreter (in category 'platform specific') ----- defaultInputInterpreter + | platformName osVersion | - | platformName | platformName := Smalltalk platformName. + osVersion := Smalltalk getSystemAttribute: 1002. + (platformName = 'Win32' and: [osVersion = 'CE']) + ifTrue: [^NoInputInterpreter new]. + platformName = 'Win32' ifTrue: [^MacRomanInputInterpreter new]. - platformName = 'Win32' ifTrue: [^UTF32InputInterpreter new]. ^NoInputInterpreter new! Item was changed: ----- Method: NativeImageSegment>>rootsIncludingBlocks (in category 'read/write segment') ----- rootsIncludingBlocks "For export segments only. Return a new roots array with more objects. (Caller should store into rootArray.) Collect Blocks and external methods pointed to by them. Put them into the roots list. Then ask for the segment again." | extras have | userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. extras := OrderedCollection new. outPointers do: [:anOut | anOut class == CompiledMethod ifTrue: [extras add: anOut]. (anOut isBlock) ifTrue: [extras add: anOut]. (anOut class == Context) ifTrue: [extras add: anOut]]. [have := extras size. extras copy do: [:anOut | anOut isBlock ifTrue: [ anOut home ifNotNil: [ (extras includes: anOut home) ifFalse: [extras add: anOut home]]]. + (anOut class == MethodContext) ifTrue: [ - (anOut class == Context) ifTrue: [ anOut method ifNotNil: [ (extras includes: anOut method) ifFalse: [extras add: anOut method]]]]. have = extras size] whileFalse. extras := extras select: [:ea | (arrayOfRoots includes: ea) not]. extras isEmpty ifTrue: [^ nil]. "no change" ^ arrayOfRoots, extras! Item was changed: ----- Method: NativeImageSegment>>storeDataOn: (in category 'fileIn/Out') ----- storeDataOn: aDataStream "Don't wrote the array of Roots. Also remember the structures of the classes of objects inside the segment." | tempRoots tempOutP list | state = #activeCopy ifFalse: [self error: 'wrong state']. "real state is activeCopy, but we changed it will be right when coming in" tempRoots := arrayOfRoots. tempOutP := outPointers. outPointers := outPointers shallowCopy. self prepareToBeSaved. arrayOfRoots := nil. state := #imported. super storeDataOn: aDataStream. "record my inst vars" arrayOfRoots := tempRoots. outPointers := tempOutP. state := #activeCopy. aDataStream references at: #AnImageSegment put: false. "the false is meaningless" "This key in refs is the flag that there is an ImageSegment in this file." "Find the receivers of blocks in the segment. Need to get the structure of their classes into structures. Put the receivers into references." (aDataStream byteStream isKindOf: DummyStream) ifTrue: [ list := Set new. arrayOfRoots do: [:ea | ea isBlock | (ea class == Context) ifTrue: [ list add: ea receiver class ]]. aDataStream references at: #BlockReceiverClasses put: list].! Item was changed: ----- Method: Preferences class>>loadPreferencesFrom: (in category 'initialization - save/load') ----- loadPreferencesFrom: aFile + + | stream params dict desktopColor patternsToIgnore | + patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). - | stream params dict desktopColor | stream := ReferenceStream fileNamed: aFile. params := stream next. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. + dict keys + reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] + thenDo: [:key | | value | + value := dict at: key. + (self preferenceAt: key ifAbsent: [nil]) ifNotNil: + [:pref | [pref preferenceValue: value preferenceValue] + on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. - dict keysAndValuesDo: - [:key :value | (self preferenceAt: key ifAbsent: [nil]) ifNotNil: - [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Smalltalk isMorphic ifTrue: [ Project current world fillStyle: desktopColor ] ifFalse: [ self desktopColor: desktopColor. ScheduledControllers updateGray ]! Item was changed: ----- Method: Preferences class>>setFlag:toValue:during: (in category 'get/set - flags') ----- setFlag: prefSymbol toValue: aBoolean during: aBlock "Set the flag to the given value for the duration of aBlock" (self valueOfFlag: prefSymbol) in: [:previous | self setFlag: prefSymbol toValue: aBoolean. + aBlock ensure: [self setFlag: prefSymbol toValue: previous]].! - ^ aBlock ensure: [self setFlag: prefSymbol toValue: previous]].! Item was changed: ----- Method: Preferences class>>setPreference:toValue:during: (in category 'get/set') ----- setPreference: prefSymbol toValue: anObject during: aBlock (self valueOfPreference: prefSymbol) in: [:previous | self setPreference: prefSymbol toValue: anObject. + aBlock ensure: [self setPreference: prefSymbol toValue: previous]].! - ^ aBlock ensure: [self setPreference: prefSymbol toValue: previous]]! Item was changed: ----- Method: Preferences class>>storePreferencesIn: (in category 'initialization - save/load') ----- storePreferencesIn: aFileName | stream prefsSnapshot | #(Prevailing PersonalPreferences) do: [:ea | Parameters removeKey: ea ifAbsent: []]. stream := ReferenceStream fileNamed: aFileName. stream nextPut: Parameters. prefsSnapshot := preferencesDictionary copy. + prefsSnapshot keysAndValuesDo: [:key :pref | + [prefsSnapshot at: key put: pref asPreference] + on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]. - prefsSnapshot keysAndValuesDo: [:key :pref | prefsSnapshot at: key put: pref asPreference]. stream nextPut: prefsSnapshot. stream nextPut: (Smalltalk isMorphic ifTrue:[Project current world fillStyle] ifFalse:[self desktopColor]). stream close! Item was added: + ----- Method: SmalltalkImage class>>test2 (in category 'instance creation') ----- + test2! Item was changed: ----- Method: SmalltalkImage>>openSourceFiles (in category 'sources, changes log') ----- openSourceFiles + self startingUpInNewLocation ifTrue: + [ "Reset the author initials to blank when the image gets moved" - - self imageName = LastImageName ifFalse: - ["Reset the author initials to blank when the image gets moved" LastImageName := self imageName. + Utilities authorInitials: String empty ]. - Utilities authorInitials: '']. FileDirectory openSources: self sourcesName andChanges: self changesName forImage: LastImageName. SourceFileArray install! Item was changed: ----- Method: SmalltalkImage>>patchSystem (in category 'command line') ----- patchSystem 'patch.st' asDirectoryEntry ifNotNil: [ : patchEntry | patchEntry modificationTime > Smalltalk imageName asDirectoryEntry modificationTime ifTrue: [ Notification signal: 'Patching system...'. + patchEntry readStreamDo: [ : stream | stream fileIn ] ] - FileStream - fileNamed: 'patch.st' - do: - [ : stream | stream fileIn ] ] ifFalse: [ self error: 'patch.st file is older than the image file. Aborting.' ] ]! Item was changed: ----- Method: SmalltalkImage>>run: (in category 'command line') ----- run: aBlock [ [ self patchSystem. (aBlock numArgs = 1 and: [ self arguments size > 1 ]) ifTrue: [ "Allow a large, variable number of arguments to be passed as an Array to aBlock." aBlock value: self arguments ] ifFalse: [ aBlock valueWithEnoughArguments: self arguments ] ] - on: ProgressInitiationException - do: - [ : pie | "Don't want to log this notification." - pie defaultAction ] ] - on: Notification , Warning - do: - [ : noti | FileStream stdout - nextPutAll: DateAndTime now asString ; - space ; - nextPutAll: noti description ; - cr. - noti resume ] on: SyntaxErrorNotification do: [ : err | FileStream stdout nextPutAll: err errorCode ; cr; flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] + on: Error , ProvideAnswerNotification - on: Error do: [ : err | err printVerboseOn: FileStream stderr. FileStream stderr flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] + ifFalse: [ err pass ] ] + on: ProgressInitiationException + do: + [ : pie | "Don't want to log this Notification." + pie defaultAction ] ] + on: Notification , Warning + do: + [ : noti | FileStream stdout + nextPutAll: DateAndTime now asString ; + space ; + nextPutAll: noti description ; + cr. + noti resume ] + ! - ifFalse: [ err pass ] ]! Item was added: + ----- Method: SmalltalkImage>>startingUpInNewLocation (in category 'startup list') ----- + startingUpInNewLocation + ^ self imageName ~= LastImageName! Item was changed: ----- Method: SystemNavigation class>>privateAuthorsRaw (in category 'class initialization') ----- (excessive size, no diff calculated) Item was changed: ----- Method: UserInterfaceThemeRequest>>doesNotUnderstand: (in category 'lookup') ----- doesNotUnderstand: aMessage "Look up the visual attribute specified by aMessage's #selector in the current theme for the current target object." aMessage numArgs = 0 ifTrue: [ ^ (self theme get: self target class -> aMessage selector) ifNil: [(self theme respondsTo: aMessage selector) ifTrue: [self theme perform: aMessage selector] ifFalse: [nil "unset property"]]]. - aMessage numArgs = 1 ifTrue: [ - ^ self theme - set: self target class -> aMessage selector asSimpleGetter - to: aMessage arguments first]. - ^ self theme perform: aMessage selector withArguments: aMessage arguments.! Item was changed: ----- Method: Utilities class>>useAuthorInitials:during: (in category 'identification') ----- useAuthorInitials: temporaryAuthorInitials during: aBlock | originalAuthorInitials | originalAuthorInitials := AuthorInitials. + [ + AuthorInitials := temporaryAuthorInitials. + aBlock value ] - ^[ AuthorInitials := temporaryAuthorInitials. - aBlock value ] ensure: [ AuthorInitials := originalAuthorInitials ] ! Item was changed: ----- Method: Utilities class>>useAuthorName:during: (in category 'identification') ----- useAuthorName: temporaryAuthorName during: aBlock | originalAuthorName | originalAuthorName := AuthorName. + [ + AuthorName := temporaryAuthorName. + aBlock value ] - ^[ AuthorName := temporaryAuthorName. - aBlock value ] ensure: [ AuthorName := originalAuthorName ] ! Item was changed: + (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors.'! - (PackageInfo named: 'System') postscript: 'Preferences removePreference: #bigDisplay.'!

1 0

The Treated Inbox: System-cmm.1145.mcz
by commits＠source.squeak.org 31 Aug '22

31 Aug '22

Chris Muller uploaded a new version of System to project The Treated Inbox: http://source.squeak.org/treated/System-cmm.1145.mcz ==================== Summary ==================== Name: System-cmm.1145 Author: cmm Time: 31 August 2022, 4:57:27.059229 pm UUID: 65825d0e-dee7-4791-8d61-66d1bd07022a Ancestors: System-cmm.1144 new server email test. Ignore. =============== Diff against System-mt.1142 =============== Item was changed: ----- Method: CommunityTheme class>>addDarkScrollables: (in category 'instance creation') ----- addDarkScrollables: aUserInterfaceTheme "self createDark apply." "Scroll bars" aUserInterfaceTheme set: #thumbColor for: #ScrollBar to: self dbGray; set: #thumbBorderColor for: #ScrollBar to: self dbGray twiceDarker. "Scroll panes (includes generic stuff for list widgets, tree widgets, and text widgets." aUserInterfaceTheme set: #borderColor for: #ScrollPane to: (Color transparent) ; "So the search box isn't outlined." set: #color for: #ScrollPane to: self dbBackground. "List widgets" aUserInterfaceTheme set: #textColor for: #PluggableListMorph to: (Color gray: 0.9); set: #selectionColor for: #PluggableListMorph to: self dbSelection; set: #selectionTextColor for: #PluggableListMorph to: Color white ; derive: #multiSelectionColor for: #PluggableListMorph from: #PluggableListMorph at: #selectionColor do: [:c | c twiceDarker]; set: #filterColor for: #PluggableListMorph to: (self dbYellow alpha: 0.4); derive: #filterTextColor for: #PluggableListMorph from: #PluggableListMorph at: #textColor ; set: #preSelectionModifier for: #PluggableListMorph to: [ [:c | c twiceDarker ] ]; set: #hoverSelectionModifier for: #PluggableListMorph to: [ [:c | c twiceDarker alpha: 0.5 ] ]. "Tree widgets" aUserInterfaceTheme set: #highlightTextColor for: #SimpleHierarchicalListMorph to: self dbYellow lighter lighter; set: #lineColor for: #SimpleHierarchicalListMorph to: Color gray. "Text widgets" aUserInterfaceTheme set: #textColor for: #PluggableTextMorph to: (Color gray: 0.9); set: #caretColor for: #PluggableTextMorph to: Color orange darker; set: #selectionColor for: #PluggableTextMorph to: (self dbSelection duller duller); set: #unfocusedSelectionModifier for: #PluggableTextMorph to: [ [:c | c duller] ]; set: #adornmentReadOnly for: #PluggableTextMorph to: self dbPurple; set: #adornmentRefuse for: #PluggableTextMorph to: self dbBlue; set: #adornmentConflict for: #PluggableTextMorph to: self dbRed; set: #adornmentDiff for: #PluggableTextMorph to: self dbGreen; set: #adornmentNormalEdit for: #PluggableTextMorph to: self dbOrange; set: #adornmentDiffEdit for: #PluggableTextMorph to: self dbYellow; set: #frameAdornmentWidth for: #PluggableTextMorph to: 2. aUserInterfaceTheme + set: #balloonTextColor for: #PluggableTextMorphPlus to: self dbComment! - set: #balloonTextColor for: #PluggableTextMorphPlus to: Color lightGray! Item was changed: ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn') ----- comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal receiverClasses rootsToUnhiberhate myProject existing forgetDoItsClass endianness | forgetDoItsClass := Set new. RecentlyRenamedClasses := nil. "in case old data hanging around" mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." self fixCapitalizationOfSymbols. endianness := self endianness. segment := self loadSegmentFrom: segment outPointers: outPointers. arrayOfRoots := segment first. mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing := TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses := self restoreEndianness: endianness ~~ Smalltalk endianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. rootsToUnhiberhate := OrderedCollection new. arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: ScriptEditorMorph) or: [(importedObject isKindOf: TileMorph) or: [(importedObject isMemberOf: ScriptingTileHolder) or: [importedObject isKindOf: CompoundTileMorph]]]) ifTrue: [ rootsToUnhiberhate add: importedObject ]. (importedObject isMemberOf: Project) ifTrue: [ myProject := importedObject. importedObject ensureChangeSetNameUnique. Project addingProject: importedObject. importedObject restoreReferences. self dependentsRestore: importedObject. ScriptEditorMorph writingUniversalTiles: ((importedObject projectPreferenceAt: #universalTiles) ifNil: [false])]]. myProject ifNotNil: [ myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate asArray. ]. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal | aFake removeFromSystemUnlogged. aFake becomeForward: aReal]. SystemOrganization removeEmptyCategories]. + forgetDoItsClass do: [:c | c forgetDoIts]. - forgetDoItsClass do: [:c | self forgetDoItsInClass: c]. "^ self" ! Item was removed: - ----- Method: ImageSegment>>forgetDoItsInClass: (in category 'private') ----- - forgetDoItsInClass: aClass - "get rid of old DoIt methods and bogus entries in the ClassOrganizer." - - SystemChangeNotifier uniqueInstance doSilently: [ - aClass organization - removeElement: #DoIt; - removeElement: #DoItIn:. - ]. - - aClass - basicRemoveSelector: #DoIt; - basicRemoveSelector: #DoItIn:! Item was changed: ----- Method: Locale class>>defaultInputInterpreter (in category 'platform specific') ----- defaultInputInterpreter + | platformName osVersion | - | platformName | platformName := Smalltalk platformName. + osVersion := Smalltalk getSystemAttribute: 1002. + (platformName = 'Win32' and: [osVersion = 'CE']) + ifTrue: [^NoInputInterpreter new]. + platformName = 'Win32' ifTrue: [^MacRomanInputInterpreter new]. - platformName = 'Win32' ifTrue: [^UTF32InputInterpreter new]. ^NoInputInterpreter new! Item was changed: ----- Method: NativeImageSegment>>rootsIncludingBlocks (in category 'read/write segment') ----- rootsIncludingBlocks "For export segments only. Return a new roots array with more objects. (Caller should store into rootArray.) Collect Blocks and external methods pointed to by them. Put them into the roots list. Then ask for the segment again." | extras have | userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. extras := OrderedCollection new. outPointers do: [:anOut | anOut class == CompiledMethod ifTrue: [extras add: anOut]. (anOut isBlock) ifTrue: [extras add: anOut]. (anOut class == Context) ifTrue: [extras add: anOut]]. [have := extras size. extras copy do: [:anOut | anOut isBlock ifTrue: [ anOut home ifNotNil: [ (extras includes: anOut home) ifFalse: [extras add: anOut home]]]. + (anOut class == MethodContext) ifTrue: [ - (anOut class == Context) ifTrue: [ anOut method ifNotNil: [ (extras includes: anOut method) ifFalse: [extras add: anOut method]]]]. have = extras size] whileFalse. extras := extras select: [:ea | (arrayOfRoots includes: ea) not]. extras isEmpty ifTrue: [^ nil]. "no change" ^ arrayOfRoots, extras! Item was changed: ----- Method: NativeImageSegment>>storeDataOn: (in category 'fileIn/Out') ----- storeDataOn: aDataStream "Don't wrote the array of Roots. Also remember the structures of the classes of objects inside the segment." | tempRoots tempOutP list | state = #activeCopy ifFalse: [self error: 'wrong state']. "real state is activeCopy, but we changed it will be right when coming in" tempRoots := arrayOfRoots. tempOutP := outPointers. outPointers := outPointers shallowCopy. self prepareToBeSaved. arrayOfRoots := nil. state := #imported. super storeDataOn: aDataStream. "record my inst vars" arrayOfRoots := tempRoots. outPointers := tempOutP. state := #activeCopy. aDataStream references at: #AnImageSegment put: false. "the false is meaningless" "This key in refs is the flag that there is an ImageSegment in this file." "Find the receivers of blocks in the segment. Need to get the structure of their classes into structures. Put the receivers into references." (aDataStream byteStream isKindOf: DummyStream) ifTrue: [ list := Set new. arrayOfRoots do: [:ea | ea isBlock | (ea class == Context) ifTrue: [ list add: ea receiver class ]]. aDataStream references at: #BlockReceiverClasses put: list].! Item was changed: ----- Method: Preferences class>>loadPreferencesFrom: (in category 'initialization - save/load') ----- loadPreferencesFrom: aFile + + | stream params dict desktopColor patternsToIgnore | + patternsToIgnore := #('*updateMapName' '*defaultUpdateURL'). - | stream params dict desktopColor | stream := ReferenceStream fileNamed: aFile. params := stream next. self assert: (params isKindOf: IdentityDictionary). params removeKey: #PersonalDictionaryOfPreferences. dict := stream next. self assert: (dict isKindOf: IdentityDictionary). desktopColor := stream next. stream close. + dict keys + reject: [:key | patternsToIgnore anySatisfy: [:pattern | pattern match: key]] + thenDo: [:key | | value | + value := dict at: key. + (self preferenceAt: key ifAbsent: [nil]) ifNotNil: + [:pref | [pref preferenceValue: value preferenceValue] + on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. - dict keysAndValuesDo: - [:key :value | (self preferenceAt: key ifAbsent: [nil]) ifNotNil: - [:pref | [pref preferenceValue: value preferenceValue] on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]]. params keysAndValuesDo: [ :key :value | self setParameter: key to: value ]. Smalltalk isMorphic ifTrue: [ Project current world fillStyle: desktopColor ] ifFalse: [ self desktopColor: desktopColor. ScheduledControllers updateGray ]! Item was changed: ----- Method: Preferences class>>setFlag:toValue:during: (in category 'get/set - flags') ----- setFlag: prefSymbol toValue: aBoolean during: aBlock "Set the flag to the given value for the duration of aBlock" (self valueOfFlag: prefSymbol) in: [:previous | self setFlag: prefSymbol toValue: aBoolean. + aBlock ensure: [self setFlag: prefSymbol toValue: previous]].! - ^ aBlock ensure: [self setFlag: prefSymbol toValue: previous]].! Item was changed: ----- Method: Preferences class>>setPreference:toValue:during: (in category 'get/set') ----- setPreference: prefSymbol toValue: anObject during: aBlock (self valueOfPreference: prefSymbol) in: [:previous | self setPreference: prefSymbol toValue: anObject. + aBlock ensure: [self setPreference: prefSymbol toValue: previous]].! - ^ aBlock ensure: [self setPreference: prefSymbol toValue: previous]]! Item was changed: ----- Method: Preferences class>>storePreferencesIn: (in category 'initialization - save/load') ----- storePreferencesIn: aFileName | stream prefsSnapshot | #(Prevailing PersonalPreferences) do: [:ea | Parameters removeKey: ea ifAbsent: []]. stream := ReferenceStream fileNamed: aFileName. stream nextPut: Parameters. prefsSnapshot := preferencesDictionary copy. + prefsSnapshot keysAndValuesDo: [:key :pref | + [prefsSnapshot at: key put: pref asPreference] + on: Deprecation do: [ : err | "Ignore preferences which may not be supported anymore."]]. - prefsSnapshot keysAndValuesDo: [:key :pref | prefsSnapshot at: key put: pref asPreference]. stream nextPut: prefsSnapshot. stream nextPut: (Smalltalk isMorphic ifTrue:[Project current world fillStyle] ifFalse:[self desktopColor]). stream close! Item was added: + ----- Method: SmalltalkImage class>>test (in category 'instance creation') ----- + test + ! Item was changed: ----- Method: SmalltalkImage>>openSourceFiles (in category 'sources, changes log') ----- openSourceFiles + self startingUpInNewLocation ifTrue: + [ "Reset the author initials to blank when the image gets moved" - - self imageName = LastImageName ifFalse: - ["Reset the author initials to blank when the image gets moved" LastImageName := self imageName. + Utilities authorInitials: String empty ]. - Utilities authorInitials: '']. FileDirectory openSources: self sourcesName andChanges: self changesName forImage: LastImageName. SourceFileArray install! Item was changed: ----- Method: SmalltalkImage>>patchSystem (in category 'command line') ----- patchSystem 'patch.st' asDirectoryEntry ifNotNil: [ : patchEntry | patchEntry modificationTime > Smalltalk imageName asDirectoryEntry modificationTime ifTrue: [ Notification signal: 'Patching system...'. + patchEntry readStreamDo: [ : stream | stream fileIn ] ] - FileStream - fileNamed: 'patch.st' - do: - [ : stream | stream fileIn ] ] ifFalse: [ self error: 'patch.st file is older than the image file. Aborting.' ] ]! Item was changed: ----- Method: SmalltalkImage>>run: (in category 'command line') ----- run: aBlock [ [ self patchSystem. (aBlock numArgs = 1 and: [ self arguments size > 1 ]) ifTrue: [ "Allow a large, variable number of arguments to be passed as an Array to aBlock." aBlock value: self arguments ] ifFalse: [ aBlock valueWithEnoughArguments: self arguments ] ] - on: ProgressInitiationException - do: - [ : pie | "Don't want to log this notification." - pie defaultAction ] ] - on: Notification , Warning - do: - [ : noti | FileStream stdout - nextPutAll: DateAndTime now asString ; - space ; - nextPutAll: noti description ; - cr. - noti resume ] on: SyntaxErrorNotification do: [ : err | FileStream stdout nextPutAll: err errorCode ; cr; flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] ifFalse: [ err pass ] ] + on: Error , ProvideAnswerNotification - on: Error do: [ : err | err printVerboseOn: FileStream stderr. FileStream stderr flush. self isHeadless ifTrue: [ self snapshot: false andQuit: true ] + ifFalse: [ err pass ] ] + on: ProgressInitiationException + do: + [ : pie | "Don't want to log this Notification." + pie defaultAction ] ] + on: Notification , Warning + do: + [ : noti | FileStream stdout + nextPutAll: DateAndTime now asString ; + space ; + nextPutAll: noti description ; + cr. + noti resume ] + ! - ifFalse: [ err pass ] ]! Item was added: + ----- Method: SmalltalkImage>>startingUpInNewLocation (in category 'startup list') ----- + startingUpInNewLocation + ^ self imageName ~= LastImageName! Item was changed: ----- Method: SystemNavigation class>>privateAuthorsRaw (in category 'class initialization') ----- (excessive size, no diff calculated) Item was changed: ----- Method: UserInterfaceThemeRequest>>doesNotUnderstand: (in category 'lookup') ----- doesNotUnderstand: aMessage "Look up the visual attribute specified by aMessage's #selector in the current theme for the current target object." aMessage numArgs = 0 ifTrue: [ ^ (self theme get: self target class -> aMessage selector) ifNil: [(self theme respondsTo: aMessage selector) ifTrue: [self theme perform: aMessage selector] ifFalse: [nil "unset property"]]]. - aMessage numArgs = 1 ifTrue: [ - ^ self theme - set: self target class -> aMessage selector asSimpleGetter - to: aMessage arguments first]. - ^ self theme perform: aMessage selector withArguments: aMessage arguments.! Item was changed: ----- Method: Utilities class>>useAuthorInitials:during: (in category 'identification') ----- useAuthorInitials: temporaryAuthorInitials during: aBlock | originalAuthorInitials | originalAuthorInitials := AuthorInitials. + [ + AuthorInitials := temporaryAuthorInitials. + aBlock value ] - ^[ AuthorInitials := temporaryAuthorInitials. - aBlock value ] ensure: [ AuthorInitials := originalAuthorInitials ] ! Item was changed: ----- Method: Utilities class>>useAuthorName:during: (in category 'identification') ----- useAuthorName: temporaryAuthorName during: aBlock | originalAuthorName | originalAuthorName := AuthorName. + [ + AuthorName := temporaryAuthorName. + aBlock value ] - ^[ AuthorName := temporaryAuthorName. - aBlock value ] ensure: [ AuthorName := originalAuthorName ] ! Item was changed: + (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors.'! - (PackageInfo named: 'System') postscript: 'Preferences removePreference: #bigDisplay.'!

1 0

The Trunk: EToys-ct.481.mcz
by commits＠source.squeak.org 28 Aug '22

28 Aug '22

Christoph Thiede uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.481.mcz ==================== Summary ==================== Name: EToys-ct.481 Author: ct Time: 28 August 2022, 3:41:10.098075 pm UUID: d2de7089-de64-b74c-a3fa-bd61108e1315 Ancestors: EToys-ct.479 Fixes MidiInputMorph so that one can actually select a valid input port instead of an output port (#setMIDIPort). Fixes pan and vol sliders, adds high-dpi support, and uses a DropDownChoiceMorph for the instrument. Note that we might still change the styl the instrument selector later. =============== Diff against EToys-ct.479 =============== Item was changed: ----- Method: MidiInputMorph>>addChannelControlsFor: (in category 'accessing') ----- addChannelControlsFor: channelIndex | r divider col | r := self makeRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. r addMorphBack: (self channelNumAndMuteButtonFor: channelIndex). + r addMorphBack: (Morph new extent: 10 px @ 5 px; color: color). "spacer" - r addMorphBack: (Morph new extent: 10@5; color: color). "spacer" r addMorphBack: (self panAndVolControlsFor: channelIndex). divider := AlignmentMorph new + extent: 10 px @ 1 px; - extent: 10@1; layoutInset: 0; + borderStyle: (BorderStyle raised width: 1 px); - borderStyle: (BorderStyle raised width: 1); color: color; hResizing: #spaceFill; vResizing: #rigid. col := self lastSubmorph. col addMorphBack: divider. + col addMorphBack: r.! - col addMorphBack: r. - ! Item was changed: ----- Method: MidiInputMorph>>channelNumAndMuteButtonFor: (in category 'accessing') ----- channelNumAndMuteButtonFor: channelIndex | muteButton instSelector r | muteButton := SimpleSwitchMorph new onColor: (Color r: 1.0 g: 0.6 b: 0.6); offColor: color; color: color; label: 'Mute' translated; target: midiSynth; actionSelector: #mutedForChannel:put:; arguments: (Array with: channelIndex). + instSelector := DropDownChoiceMorph new + extent: 120 px @ 18 px; - instSelector := PopUpChoiceMorph new - extent: 95@14; contentsClipped: 'oboe1'; target: self; actionSelector: #atChannel:from:selectInstrument:; getItemsSelector: #instrumentChoicesForChannel:; getItemsArgs: (Array with: channelIndex). instSelector arguments: (Array with: channelIndex with: instSelector). instrumentSelector at: channelIndex put: instSelector. r := self makeRow + hResizing: #spaceFill; - hResizing: #rigid; vResizing: #spaceFill; + extent: 70 px @ 10 px. - extent: 70@10. r addMorphBack: (StringMorph contents: channelIndex printString + font: (TextStyle defaultFont asPointSize: TextStyle defaultFont pointSize * 1.57)). - font: (TextStyle default fontOfSize: 24)). channelIndex < 10 + ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 px @ 8 px)] "spacer" + ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px)]. "spacer" - ifTrue: [r addMorphBack: (Morph new color: color; extent: 19@8)] "spacer" - ifFalse: [r addMorphBack: (Morph new color: color; extent: 8@8)]. "spacer" r addMorphBack: instSelector. r addMorphBack: (AlignmentMorph newRow color: color). "spacer" r addMorphBack: muteButton. ^ r! Item was changed: ----- Method: MidiInputMorph>>defaultBorderWidth (in category 'initialization') ----- defaultBorderWidth "answer the default border width for the receiver" + ^ 2 px! - ^ 2! Item was changed: ----- Method: MidiInputMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self listDirection: #topToBottom; wrapCentering: #center; cellPositioning: #topCenter; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + layoutInset: 3 px. - hResizing: #spaceFill; - vResizing: #spaceFill; - layoutInset: 3. midiPortNumber := nil. midiSynth := MIDISynth new. instrumentSelector := Array new: 16. self removeAllMorphs. self addMorphBack: self makeControls. self addMorphBack: (AlignmentMorph newColumn color: color; layoutInset: 0). self addChannelControlsFor: 1. + self extent: 20 px @ 20 px! - self extent: 20 @ 20! Item was changed: ----- Method: MidiInputMorph>>makeControls (in category 'initialization') ----- makeControls | bb r reverbSwitch onOffSwitch | bb := SimpleButtonMorph new target: self; + borderStyle: (BorderStyle raised width: 2 px); - borderStyle: (BorderStyle raised width: 2); color: color. r := AlignmentMorph newRow. r color: bb color; borderWidth: 0; layoutInset: 0. + r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 px @ 5 px. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r addMorphBack: ( bb label: '<>'; actWhen: #buttonDown; actionSelector: #invokeMenu). onOffSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); + borderWidth: 2 px; - borderWidth: 2; label: 'On' translated; actionSelector: #toggleOnOff; target: self; setSwitchState: false. r addMorphBack: onOffSwitch. reverbSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); + borderWidth: 2 px; - borderWidth: 2; label: 'Reverb Disable' translated; actionSelector: #disableReverb:; target: self; setSwitchState: SoundPlayer isReverbOn not. r addMorphBack: reverbSwitch. ^ r! Item was changed: ----- Method: MidiInputMorph>>panAndVolControlsFor: (in category 'initialization') ----- panAndVolControlsFor: channelIndex | volSlider panSlider c r middleLine | volSlider := SimpleSliderMorph new color: color; + extent: 101 px @ 6 px; + minWidth: 101 px; - extent: 101@2; target: midiSynth; arguments: (Array with: channelIndex); + orientation: #horizontal; actionSelector: #volumeForChannel:put:; minVal: 0.0; maxVal: 1.0; adjustToValue: (midiSynth volumeForChannel: channelIndex). panSlider := SimpleSliderMorph new color: color; + extent: 101 px @ 6 px; + minWidth: 101 px; - extent: 101@2; target: midiSynth; arguments: (Array with: channelIndex); actionSelector: #panForChannel:put:; minVal: 0.0; maxVal: 1.0; adjustToValue: (midiSynth panForChannel: channelIndex). c := AlignmentMorph newColumn color: color; layoutInset: 0; wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap. middleLine := Morph new "center indicator for pan slider" color: (Color r: 0.4 g: 0.4 b: 0.4); + extent: 1 px @ (panSlider height - 4 px); + position: panSlider center x @ (panSlider top + 2 px). - extent: 1@(panSlider height - 4); - position: panSlider center x@(panSlider top + 2). panSlider addMorphBack: middleLine. r := self makeRow. r addMorphBack: (StringMorph contents: '0'). r addMorphBack: volSlider. r addMorphBack: (StringMorph contents: '10'). c addMorphBack: r. r := self makeRow. r addMorphBack: (StringMorph contents: 'L'). r addMorphBack: panSlider. r addMorphBack: (StringMorph contents: 'R'). c addMorphBack: r. + ^ c! - ^ c - ! Item was changed: ----- Method: MidiInputMorph>>setMIDIPort (in category 'accessing') ----- setMIDIPort | portNum | + portNum := SimpleMIDIPort inputPortNumFromUser. - portNum := SimpleMIDIPort outputPortNumFromUser. portNum ifNil: [^ self]. midiPortNumber := portNum. !

1 0

The Treated Inbox: EToys-ct.481.mcz
by commits＠source.squeak.org 28 Aug '22

28 Aug '22

Christoph Thiede uploaded a new version of EToys to project The Treated Inbox: http://source.squeak.org/treated/EToys-ct.481.mcz ==================== Summary ==================== Name: EToys-ct.481 Author: ct Time: 28 August 2022, 3:41:10.098075 pm UUID: d2de7089-de64-b74c-a3fa-bd61108e1315 Ancestors: EToys-ct.479 Fixes MidiInputMorph so that one can actually select a valid input port instead of an output port (#setMIDIPort). Fixes pan and vol sliders, adds high-dpi support, and uses a DropDownChoiceMorph for the instrument. Note that we might still change the styl the instrument selector later. =============== Diff against EToys-ct.479 =============== Item was changed: ----- Method: MidiInputMorph>>addChannelControlsFor: (in category 'accessing') ----- addChannelControlsFor: channelIndex | r divider col | r := self makeRow hResizing: #shrinkWrap; vResizing: #shrinkWrap. r addMorphBack: (self channelNumAndMuteButtonFor: channelIndex). + r addMorphBack: (Morph new extent: 10 px @ 5 px; color: color). "spacer" - r addMorphBack: (Morph new extent: 10@5; color: color). "spacer" r addMorphBack: (self panAndVolControlsFor: channelIndex). divider := AlignmentMorph new + extent: 10 px @ 1 px; - extent: 10@1; layoutInset: 0; + borderStyle: (BorderStyle raised width: 1 px); - borderStyle: (BorderStyle raised width: 1); color: color; hResizing: #spaceFill; vResizing: #rigid. col := self lastSubmorph. col addMorphBack: divider. + col addMorphBack: r.! - col addMorphBack: r. - ! Item was changed: ----- Method: MidiInputMorph>>channelNumAndMuteButtonFor: (in category 'accessing') ----- channelNumAndMuteButtonFor: channelIndex | muteButton instSelector r | muteButton := SimpleSwitchMorph new onColor: (Color r: 1.0 g: 0.6 b: 0.6); offColor: color; color: color; label: 'Mute' translated; target: midiSynth; actionSelector: #mutedForChannel:put:; arguments: (Array with: channelIndex). + instSelector := DropDownChoiceMorph new + extent: 120 px @ 18 px; - instSelector := PopUpChoiceMorph new - extent: 95@14; contentsClipped: 'oboe1'; target: self; actionSelector: #atChannel:from:selectInstrument:; getItemsSelector: #instrumentChoicesForChannel:; getItemsArgs: (Array with: channelIndex). instSelector arguments: (Array with: channelIndex with: instSelector). instrumentSelector at: channelIndex put: instSelector. r := self makeRow + hResizing: #spaceFill; - hResizing: #rigid; vResizing: #spaceFill; + extent: 70 px @ 10 px. - extent: 70@10. r addMorphBack: (StringMorph contents: channelIndex printString + font: (TextStyle defaultFont asPointSize: TextStyle defaultFont pointSize * 1.57)). - font: (TextStyle default fontOfSize: 24)). channelIndex < 10 + ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 px @ 8 px)] "spacer" + ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px)]. "spacer" - ifTrue: [r addMorphBack: (Morph new color: color; extent: 19@8)] "spacer" - ifFalse: [r addMorphBack: (Morph new color: color; extent: 8@8)]. "spacer" r addMorphBack: instSelector. r addMorphBack: (AlignmentMorph newRow color: color). "spacer" r addMorphBack: muteButton. ^ r! Item was changed: ----- Method: MidiInputMorph>>defaultBorderWidth (in category 'initialization') ----- defaultBorderWidth "answer the default border width for the receiver" + ^ 2 px! - ^ 2! Item was changed: ----- Method: MidiInputMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self listDirection: #topToBottom; wrapCentering: #center; cellPositioning: #topCenter; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + layoutInset: 3 px. - hResizing: #spaceFill; - vResizing: #spaceFill; - layoutInset: 3. midiPortNumber := nil. midiSynth := MIDISynth new. instrumentSelector := Array new: 16. self removeAllMorphs. self addMorphBack: self makeControls. self addMorphBack: (AlignmentMorph newColumn color: color; layoutInset: 0). self addChannelControlsFor: 1. + self extent: 20 px @ 20 px! - self extent: 20 @ 20! Item was changed: ----- Method: MidiInputMorph>>makeControls (in category 'initialization') ----- makeControls | bb r reverbSwitch onOffSwitch | bb := SimpleButtonMorph new target: self; + borderStyle: (BorderStyle raised width: 2 px); - borderStyle: (BorderStyle raised width: 2); color: color. r := AlignmentMorph newRow. r color: bb color; borderWidth: 0; layoutInset: 0. + r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 px @ 5 px. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r addMorphBack: ( bb label: '<>'; actWhen: #buttonDown; actionSelector: #invokeMenu). onOffSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); + borderWidth: 2 px; - borderWidth: 2; label: 'On' translated; actionSelector: #toggleOnOff; target: self; setSwitchState: false. r addMorphBack: onOffSwitch. reverbSwitch := SimpleSwitchMorph new offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); + borderWidth: 2 px; - borderWidth: 2; label: 'Reverb Disable' translated; actionSelector: #disableReverb:; target: self; setSwitchState: SoundPlayer isReverbOn not. r addMorphBack: reverbSwitch. ^ r! Item was changed: ----- Method: MidiInputMorph>>panAndVolControlsFor: (in category 'initialization') ----- panAndVolControlsFor: channelIndex | volSlider panSlider c r middleLine | volSlider := SimpleSliderMorph new color: color; + extent: 101 px @ 6 px; + minWidth: 101 px; - extent: 101@2; target: midiSynth; arguments: (Array with: channelIndex); + orientation: #horizontal; actionSelector: #volumeForChannel:put:; minVal: 0.0; maxVal: 1.0; adjustToValue: (midiSynth volumeForChannel: channelIndex). panSlider := SimpleSliderMorph new color: color; + extent: 101 px @ 6 px; + minWidth: 101 px; - extent: 101@2; target: midiSynth; arguments: (Array with: channelIndex); actionSelector: #panForChannel:put:; minVal: 0.0; maxVal: 1.0; adjustToValue: (midiSynth panForChannel: channelIndex). c := AlignmentMorph newColumn color: color; layoutInset: 0; wrapCentering: #center; cellPositioning: #topCenter; hResizing: #spaceFill; vResizing: #shrinkWrap. middleLine := Morph new "center indicator for pan slider" color: (Color r: 0.4 g: 0.4 b: 0.4); + extent: 1 px @ (panSlider height - 4 px); + position: panSlider center x @ (panSlider top + 2 px). - extent: 1@(panSlider height - 4); - position: panSlider center x@(panSlider top + 2). panSlider addMorphBack: middleLine. r := self makeRow. r addMorphBack: (StringMorph contents: '0'). r addMorphBack: volSlider. r addMorphBack: (StringMorph contents: '10'). c addMorphBack: r. r := self makeRow. r addMorphBack: (StringMorph contents: 'L'). r addMorphBack: panSlider. r addMorphBack: (StringMorph contents: 'R'). c addMorphBack: r. + ^ c! - ^ c - ! Item was changed: ----- Method: MidiInputMorph>>setMIDIPort (in category 'accessing') ----- setMIDIPort | portNum | + portNum := SimpleMIDIPort inputPortNumFromUser. - portNum := SimpleMIDIPort outputPortNumFromUser. portNum ifNil: [^ self]. midiPortNumber := portNum. !

1 0

The Treated Inbox: MorphicExtras-kfr.333.mcz
by commits＠source.squeak.org 27 Aug '22

27 Aug '22

Karl Ramberg uploaded a new version of MorphicExtras to project The Treated Inbox: http://source.squeak.org/treated/MorphicExtras-kfr.333.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.333 Author: kfr Time: 27 August 2022, 10:37:56.24479 am UUID: 7d5d485d-6fa0-1444-8c0a-a8d50a85de8d Ancestors: MorphicExtras-kfr.332 Preset button to 'maj' =============== Diff against MorphicExtras-ct.331 =============== Item was changed: ----- Method: KeyboardMorphForInput>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. + self initChordDictionary. - "" buildingChord := false. self addRecordingControls. self duration: 4 onOff: true. self durMod: #normal onOff: true. self articulation: #normal onOff: true. + self chords: #maj onOff: true. insertMode := false. + ! - self initChordDictionary! Item was changed: ----- Method: ScorePlayerMorph>>trackNumAndMuteButtonFor: (in category 'layout') ----- trackNumAndMuteButtonFor: trackIndex + | muteButton instSelector pianoRollColor r instBackground | - | muteButton instSelector pianoRollColor r | muteButton := SimpleSwitchMorph new onColor: (Color r: 1.0 g: 0.6 b: 0.6); offColor: color; color: color; label: 'Mute' translated; target: scorePlayer; actionSelector: #mutedForTrack:put:; arguments: (Array with: trackIndex). + instBackground := Morph new extent: 125 px@19 px; + color: color lighter; + borderColor: color muchDarker; + borderWidth: 1; + layoutPolicy: TableLayout new; + layoutInset: (1@0). instSelector := DropDownChoiceMorph new extent: 120 px @ 18 px; contentsClipped: 'oboe1'; target: self; actionSelector: #atTrack:from:selectInstrument:; getItemsSelector: #instrumentChoicesForTrack:; getItemsArgs: (Array with: trackIndex). instSelector arguments: (Array with: trackIndex with: instSelector). instrumentSelector at: trackIndex put: instSelector. + instBackground addMorphBack: instSelector. "select track color using same color list as PianoRollScoreMorph" pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. r := self makeRow hResizing: #spaceFill; vResizing: #spaceFill; extent: 70 px @ 10 px. r addMorphBack: ((StringMorph contents: trackIndex printString font: (TextStyle defaultFont asPointSize: TextStyle defaultFont pointSize * 1.57)) color: pianoRollColor). trackIndex < 10 ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 px @ 8 px)] "spacer" ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px)]. "spacer" r addMorphBack: (StringMorph new + extent: 100 px @ 16 px; - extent: 140 px @ 16 px; contentsClipped: (scorePlayer infoForTrack: trackIndex)). r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px). "spacer" + r addMorphBack: instBackground. - r addMorphBack: instSelector. r addMorphBack: (AlignmentMorph newRow color: color). "spacer" r addMorphBack: muteButton. ^ r!

1 0

The Trunk: Help-Squeak-Project-ct.95.mcz
by commits＠source.squeak.org 25 Aug '22

25 Aug '22

Christoph Thiede uploaded a new version of Help-Squeak-Project to project The Trunk: http://source.squeak.org/trunk/Help-Squeak-Project-ct.95.mcz ==================== Summary ==================== Name: Help-Squeak-Project-ct.95 Author: ct Time: 25 August 2022, 6:07:24.965239 pm UUID: fb22c6f4-4680-1f4c-a204-4da4beb5af20 Ancestors: Help-Squeak-Project-mt.94 Minor rephrasing/grammar fix in tutorials intro. =============== Diff against Help-Squeak-Project-mt.94 =============== Item was changed: ----- Method: SqueakTutorials class>>introduction (in category 'pages') ----- introduction "This method was automatically generated. Edit it using:" "SqueakTutorials edit: #introduction" + <generated> ^(HelpTopic title: 'Introduction' contents: + 'Here you can find some short tutorials on how to use Squeak for daily tasks. Feel free to add your own!!!!!!' readStream nextChunkText) - 'Here you will some short tutorials on how to use Squeak for daily tasks. Feel free to add your own.!!' readStream nextChunkText) key: #introduction; shouldStyle: false; yourself!

1 0

The Trunk: Morphic-ct.2037.mcz
by commits＠source.squeak.org 25 Aug '22

25 Aug '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.2037.mcz ==================== Summary ==================== Name: Morphic-ct.2037 Author: ct Time: 25 August 2022, 4:55:01.067239 pm UUID: e0f7b0d0-281d-7f4b-a906-6f78a4e49092 Ancestors: Morphic-ct.2036 Next attempt on fixing UI theme/scale factor updates for open system progress morphs. If you note any further issues, please let me know. =============== Diff against Morphic-ct.2036 =============== Item was added: + ----- Method: SystemProgressBarMorph>>extent: (in category 'updating') ----- + extent: aMorph + + | oldWidth | + oldWidth := self width. + + super extent: aMorph. + + self barSize: self barSize * (self width / oldWidth).! Item was changed: ----- Method: SystemProgressMorph>>applyUserInterfaceTheme (in category 'updating') ----- applyUserInterfaceTheme super applyUserInterfaceTheme. + self setDefaultParameters. + + self class applyUserInterfaceTheme. "update class vars first" + bars do: [:bar | bar ifNotNil: [bar extent: BarWidth @ BarHeight]]. + labels do: [:label | label ifNotNil: [label font: self font; color: self textColor]].! - self setDefaultParameters.! Item was changed: ----- Method: SystemProgressMorph>>initialize (in category 'initialization') ----- initialize super initialize. activeSlots := 0. bars := Array new: 10. labels := Array new: 10. lock := Semaphore forMutualExclusion. self setDefaultParameters; morphicLayerNumber: self class progressLayer; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #topCenter; - cellGap: 5; listCentering: #center; hResizing: #shrinkWrap; + vResizing: #shrinkWrap.! - vResizing: #shrinkWrap; - layoutInset: Inset; - minWidth: 150! Item was changed: ----- Method: SystemProgressMorph>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters "change the receiver's appareance parameters" self + cellGap: 5 px; + layoutInset: Inset; + minWidth: 150 px. + + self color: (self userInterfaceTheme color ifNil: [Color r: 0.9 g: 0.9 b: 0.9]); borderStyle: (self userInterfaceTheme borderStyle ifNil: [BorderStyle simple]) copy; borderColor: (self userInterfaceTheme borderColor ifNil: [Color gray]); borderWidth: ((self userInterfaceTheme borderWidth ifNil: [1]) * RealEstateAgent scaleFactor) truncated. Preferences menuAppearance3d ifTrue: [self addDropShadow]. self font: (self userInterfaceTheme font ifNil: [TextStyle defaultFont]); textColor: (self userInterfaceTheme textColor ifNil: [Color black]). self updateColor: self color: self color intensity: 1.!

1 0

The Trunk: MorphicExtras-ct.331.mcz
by commits＠source.squeak.org 25 Aug '22

25 Aug '22

Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.331.mcz ==================== Summary ==================== Name: MorphicExtras-ct.331 Author: ct Time: 25 August 2022, 4:39:16.167239 pm UUID: b66bddb0-2819-6f4f-87e4-fd76c3c16073 Ancestors: MorphicExtras-ct.330 Slightly revises Workspace examples. =============== Diff against MorphicExtras-ct.330 =============== Item was changed: ----- Method: Workspace class>>extraExample2 (in category '*MorphicExtras-examples') ----- extraExample2 "ToolBuilder open: Workspace extraExample2" ^ self new contents: (((self class sourceCodeAt: #extraExampleContents2) asString lines allButFirst: 3) joinSeparatedBy: Character cr); + shouldStyle: true; yourself! Item was changed: ----- Method: Workspace class>>extraExampleContents1 (in category '*MorphicExtras-examples') ----- extraExampleContents1 "This is example code for #extraExample1" + "Run each of the following lines by selecting it and pressing <cmd>d" - "Run the following lines by pressing <cmd>d:" Transcript showln: 'Hello world!!'. self inform: 'This is a dialog box. Quite easy, isn''t it?'. "Print the result of an expression using <cmd>p" 6 * 7. Float pi i exp stringForReadout. (16 factorial + 1) isPrime. (Smalltalk allClasses gather: #selectors) size.!

1 0

The Trunk: MorphicExtras-ct.330.mcz
by commits＠source.squeak.org 25 Aug '22

25 Aug '22

Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.330.mcz ==================== Summary ==================== Name: MorphicExtras-ct.330 Author: ct Time: 25 August 2022, 3:57:58.536239 pm UUID: 2e1c5775-6f30-154d-b1ba-77d1d443e805 Ancestors: MorphicExtras-ct.329 In the Score Player example, use different instruments as intended by the example track. Adds ScorePlayerMorph>>#atTrack:selectInstrument:. =============== Diff against MorphicExtras-ct.329 =============== Item was changed: ----- Method: ScorePlayerMorph class>>extraExample (in category '*MorphicExtras-examples') ----- extraExample "ScorePlayerMorph extraExample openInHand" + | scorePlayerMorph | + scorePlayerMorph := self on: MIDIScore extraExample. + #('organ1' 'oboe1' 'brass1' 'oboe1' 'oboe2' 'bass1' 'bassoon1' 'bass1' 'pluckedElecBass' 'bass1') + withIndexDo: [:name :index | + scorePlayerMorph atTrack: index selectInstrument: name]. + ^ scorePlayerMorph! - ^ self on: MIDIScore extraExample! Item was added: + ----- Method: ScorePlayerMorph>>atTrack:selectInstrument: (in category 'controls') ----- + atTrack: trackIndex selectInstrument: selection + + ^ self atTrack: trackIndex from: (instrumentSelector at: trackIndex) selectInstrument: selection!

1 0

The Trunk: MorphicExtras-ct.329.mcz
by commits＠source.squeak.org 25 Aug '22

25 Aug '22

Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.329.mcz ==================== Summary ==================== Name: MorphicExtras-ct.329 Author: ct Time: 25 August 2022, 3:48:03.569239 pm UUID: b7b5c235-4960-2644-9e19-9bc424db05e5 Ancestors: MorphicExtras-ct.328 Score Player: For instrument selection, uses a DropDownChoiceMorph in favor of a PopUpChoiceMorph. =============== Diff against MorphicExtras-ct.328 =============== Item was changed: ----- Method: DropDownChoiceMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + aCanvas drawString: contents in: (bounds insetBy: 2 px) font: self fontToUse color: color. - aCanvas drawString: contents in: (bounds insetBy: 2) font: self fontToUse color: color. border ifNotNil: [aCanvas frameAndFillRectangle: bounds fillColor: Color transparent + borderWidth: 1 px - borderWidth: 1 borderColor: Color black]. aCanvas paintImage: SubMenuMarker + at: (self right - 8 px @ ((self top + self bottom - SubMenuMarker height) // 2))! - at: (self right - 8 @ ((self top + self bottom - SubMenuMarker height) // 2))! Item was changed: ----- Method: DropDownChoiceMorph>>maxExtent: (in category 'drawing') ----- maxExtent: listOfStrings | h maxW | maxW := 0. listOfStrings do: [:str | | f w | f := self fontToUse. w := f widthOfString: str. h := f height. maxW := maxW max: w]. + self extent: (maxW + 4 px + h) @ (h + 4 px). - self extent: (maxW + 4 + h) @ (h + 4). self changed! Item was changed: ----- Method: ScorePlayerMorph>>trackNumAndMuteButtonFor: (in category 'layout') ----- trackNumAndMuteButtonFor: trackIndex | muteButton instSelector pianoRollColor r | muteButton := SimpleSwitchMorph new onColor: (Color r: 1.0 g: 0.6 b: 0.6); offColor: color; color: color; label: 'Mute' translated; target: scorePlayer; actionSelector: #mutedForTrack:put:; arguments: (Array with: trackIndex). + instSelector := DropDownChoiceMorph new + extent: 120 px @ 18 px; - instSelector := PopUpChoiceMorph new - extent: 95 px @ 14 px; contentsClipped: 'oboe1'; target: self; actionSelector: #atTrack:from:selectInstrument:; getItemsSelector: #instrumentChoicesForTrack:; getItemsArgs: (Array with: trackIndex). instSelector arguments: (Array with: trackIndex with: instSelector). instrumentSelector at: trackIndex put: instSelector. "select track color using same color list as PianoRollScoreMorph" pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. r := self makeRow hResizing: #spaceFill; vResizing: #spaceFill; extent: 70 px @ 10 px. r addMorphBack: ((StringMorph contents: trackIndex printString font: (TextStyle defaultFont asPointSize: TextStyle defaultFont pointSize * 1.57)) color: pianoRollColor). trackIndex < 10 ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 px @ 8 px)] "spacer" ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px)]. "spacer" r addMorphBack: (StringMorph new + extent: 140 px @ 16 px; - extent: 80 px @ 14 px; contentsClipped: (scorePlayer infoForTrack: trackIndex)). r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px). "spacer" r addMorphBack: instSelector. r addMorphBack: (AlignmentMorph newRow color: color). "spacer" r addMorphBack: muteButton. ^ r!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages August 2022