Packages April 2023

packages@lists.squeakfoundation.org

1 participants
37 discussions

FFI: FFI-Kernel-eem.228.mcz
by commits＠source.squeak.org 13 Apr '23

13 Apr '23

Eliot Miranda uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-eem.228.mcz ==================== Summary ==================== Name: FFI-Kernel-eem.228 Author: eem Time: 13 April 2023, 2:40:45.749373 pm UUID: 77163f53-9648-49ae-904a-d16fd63af2ab Ancestors: FFI-Kernel-eem.227 Make sure that compiledSpecs in ExternalLibraryFunctions in CompiledMethods are up-to-date after a platform change. The current FFI code invalidates these on platform change, but does nothing to update them. Hence cache allInstances of ExternalLibraryFunction in a class var to avoid having to do an allInstancesDo: whenever the platform changes. =============== Diff against FFI-Kernel-eem.227 =============== Item was changed: ExternalFunction subclass: #ExternalLibraryFunction instanceVariableNames: 'name module errorCodeName' + classVariableNames: 'Instances' - classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalLibraryFunction commentStamp: '' prior: 0! An ExternalLibraryFunction specifies a fully qualified function from an external library. Instance variables: name <String | Integer> name or ordinal of function module <String | nil> name of module (nil if bound in the VM). errorCodeName <String | nil> name of temp receiving error code, if any! Item was added: + ----- Method: ExternalLibraryFunction class>>instances (in category 'private') ----- + instances + "Cache our instances for faster reinitialization." + ^Instances ifNil: [Instances := WeakSet withAll: self allInstances]! Item was added: + ----- Method: ExternalLibraryFunction class>>new (in category 'instance creation') ----- + new + ^self instances add: super new! Item was added: + ----- Method: ExternalLibraryFunction class>>platformChangedFrom:to: (in category 'instance initialization') ----- + platformChangedFrom: lastPlatform to: currentPlatform + "Byte size or byte alignment for atomic types might be different on the new platform." + + "Make sure that the cache of all instances is up-to-date before using it..." + Instances ifNil: [self new]. + + "Get all instances to update their compiledSpecs so that FFI calls work." + self updateArgTypeSpecs! Item was added: + ----- Method: ExternalLibraryFunction class>>updateArgTypeSpecs (in category 'instance initialization') ----- + updateArgTypeSpecs + self instances do: [:elf| elf updateArgTypeSpecs]! Item was added: + ----- Method: ExternalLibraryFunction>>updateArgTypeSpecs (in category 'instance initialization') ----- + updateArgTypeSpecs + argTypes ifNotNil: + [:typeArray| typeArray do: [:argType| argType updateFromReferentClass]]! Item was added: + ----- Method: ExternalType>>updateFromReferentClass (in category 'instance initialization') ----- + updateFromReferentClass + "If I have a referentClass update my compiledSpec to reflect the new state of the system, e.g. after a platform change." + + referentClass ifNotNil: [:refClass| self newReferentClass: refClass]! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull ] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." + { ExternalAddress. ExternalType. ExternalPool. ExternalLibrary. ExternalLibraryFunction } - { ExternalAddress. ExternalType. ExternalPool. ExternalLibrary } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]]. + self checkFFIOnStartUp ifTrue: [self checkFFI]]! - self checkFFIOnStartUp ifTrue: [self checkFFI]].!

1 0

The Trunk: ReleaseBuilder-mt.244.mcz
by commits＠source.squeak.org 13 Apr '23

13 Apr '23

Marcel Taeumel uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-mt.244.mcz ==================== Summary ==================== Name: ReleaseBuilder-mt.244 Author: mt Time: 13 April 2023, 3:12:12.009682 pm UUID: 7108259d-d48f-6946-9b08-e440f57baeec Ancestors: ReleaseBuilder-mt.243 Complements Tools-mt.1198 =============== Diff against ReleaseBuilder-mt.243 =============== Item was changed: ----- Method: ReleaseBuilder class>>configureTools (in category 'scripts') ----- configureTools "Initialize well-known tools and other resources." FileList initialize. FileServices initialize. "register file reader services" RealEstateAgent standardSize: 650@425. SMLoaderPlus setDefaultFilters: #(filterSafelyAvailable). self beautifyEtoys. "Default applications and tools." + SystemBrowser default: TreeBrowser. - SystemBrowser default: Browser. MailSender default: nil. SoundService default: BaseSoundSystem. ToolSet default: StandardToolSet. WebBrowser default: nil. !

1 0

The Trunk: PreferenceBrowser-mt.156.mcz
by commits＠source.squeak.org 13 Apr '23

13 Apr '23

Marcel Taeumel uploaded a new version of PreferenceBrowser to project The Trunk: http://source.squeak.org/trunk/PreferenceBrowser-mt.156.mcz ==================== Summary ==================== Name: PreferenceBrowser-mt.156 Author: mt Time: 13 April 2023, 3:11:54.037682 pm UUID: b7d5542e-cd9a-b948-be26-a7132abf699b Ancestors: PreferenceBrowser-mt.155 Complements Tools-mt.1198 =============== Diff against PreferenceBrowser-mt.155 =============== Item was changed: ----- Method: PreferenceWizardMorph>>adjustSettingsForLowPerformance (in category 'support') ----- adjustSettingsForLowPerformance self updateLowPerformanceLabel: 'Please wait, optimizing performance...' translated. self refreshWorld. self stateGradients "flat look" ifFalse: [self toggleGradients]. self stateBlinkingCursor ifTrue: [self toggleBlinkingCursor]. self stateFastDrag ifFalse: [self toggleFastDrag]. self stateSoftShadows ifTrue: [self toggleSoftShadows]. self stateHardShadows ifTrue: [self toggleHardShadows]. self stateRoundedWindowLook ifTrue: [self toggleRoundedWindowLook]. self stateRoundedButtonLook ifTrue: [self toggleRoundedButtonLook]. + self stateTraditionalSystemBrowser ifFalse: [self toggleTraditionalSystemBrowser]. + self stateAttachToolsToMouse ifTrue: [self toggleAttachToolsToMouse]. self stateToolAndMenuIcons ifTrue: [self toggleToolAndMenuIcons]. self stateSmartHorizontalSplitters ifTrue: [self toggleSmartHorizontalSplitters]. self stateSmartVerticalSplitters ifTrue: [self toggleSmartVerticalSplitters]. PluggableListMorph highlightHoveredRow: false; filterableLists: false; highlightPreSelection: true; "Feedback is important!!" flashOnErrors: false. TheWorldMainDockingBar showSecondsInClock: false. Preferences disable: #balloonHelpInMessageLists. "Set simple background." self currentWorld setAsBackground: MorphicProject defaultFill. "Done." self updateLowPerformanceLabel: 'Settings were adjusted for optimal performance.' translated.! Item was changed: ----- Method: PreferenceWizardMorph>>initializePage05Tools (in category 'initialization - pages') ----- initializePage05Tools | currentPage pane | currentPage := pages add: self createPage. pane := self createScrollPane. currentPage addMorphBack: (self createLabel: 'Choose other settings' color: Color white). currentPage addMorphBack: pane. pane scroller firstSubmorph addAllMorphsBack: { + self createCheckbox: 'Traditional system browser' translated for: #TraditionalSystemBrowser help: 'Enable to use the traditional Smalltalk system browser, which has no tree views in its top panes but plain lists.' translated. self createCheckbox: 'Trace messages browser' translated for: #TraceMessages help: #(trace message). self createCheckbox: 'Browse class hierarchy' translated for: #AlternativeBrowseIt help: 'Whether to spawn a hierarchy browser or full system browser on browse-it commands.' translated. self createVerticalSpace. self createCheckbox: 'Reuse tool windows' translated for: #ReuseWindows help: #(window reuse). self createCheckbox: 'Tool and menu icons' translated for: #ToolAndMenuIcons help: 'Whether to show icons in tools and menus.' translated. self createVerticalSpace. self createCheckbox: 'Embed Transcript in Workspace' translated for: #WorkspaceEmbedTranscript help: #(workspace transcript). self createCheckbox: 'File out Workspace on accept' translated for: #WorkspaceFileOutOnAccept help: #(workspace accept). }. ! Item was added: + ----- Method: PreferenceWizardMorph>>stateTraditionalSystemBrowser (in category 'actions - buttons') ----- + stateTraditionalSystemBrowser + + ^ SystemBrowser default == Browser! Item was added: + ----- Method: PreferenceWizardMorph>>toggleTraditionalSystemBrowser (in category 'actions - buttons') ----- + toggleTraditionalSystemBrowser + + self stateTraditionalSystemBrowser + ifTrue: [SystemBrowser default: TreeBrowser] + ifFalse: [SystemBrowser default: Browser]. + self changed: #stateTraditionalSystemBrowser. + self resetWorld.!

1 0

The Trunk: ToolsTests-mt.120.mcz
by commits＠source.squeak.org 13 Apr '23

13 Apr '23

Marcel Taeumel uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-mt.120.mcz ==================== Summary ==================== Name: ToolsTests-mt.120 Author: mt Time: 13 April 2023, 3:11:38.460682 pm UUID: 00d3150e-fa34-9548-8449-8a1a2fcd404f Ancestors: ToolsTests-mt.119 Complements Tools-mt.1198 =============== Diff against ToolsTests-mt.119 =============== Item was changed: ----- Method: BrowserTest>>testSpawnHierarchy (in category 'tests') ----- testSpawnHierarchy | spawn | browser selectSystemCategory: browser class category. browser selectClass: browser class. browser selectMessageCategoryNamed: browser messageCategoryList last. browser messageListIndex: (browser messageList size). spawn := browser spawnHierarchy. + [self assert: spawn selectedClassName = browser selectedClassName. - [self assert: spawn selectedSystemCategory = browser selectedSystemCategory. - self assert: spawn selectedClassName = browser selectedClassName. self assert: spawn selectedMessageCategoryName = browser selectedMessageCategoryName. self assert: spawn messageListIndex = browser messageListIndex.] ensure: [ ToolBuilder default close: spawn topView ].! Item was added: + BrowserTest subclass: #TreeBrowserTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ToolsTests-Browser'! Item was added: + ----- Method: TreeBrowserTest class>>shouldInheritSelectors (in category 'testing') ----- + shouldInheritSelectors + "We must pass all basic browser tests. And more." + + ^ true! Item was added: + ----- Method: TreeBrowserTest>>setUp (in category 'running') ----- + setUp + + browser := TreeBrowser new.! Item was added: + ----- Method: TreeBrowserTest>>testMsgNoSingleChildWithEmptyParent (in category 'tests - message list') ----- + testMsgNoSingleChildWithEmptyParent + + Smalltalk allClassesDo: [:cls | | rest parent | + browser setClass: cls. + rest := browser messageCategoryRoots asOrderedCollection. + [rest notEmpty] whileTrue: [ + parent := rest removeFirst. + (browser messageCategoryHasChildren: parent) + ifTrue: [ | children | + children := browser messageCategoryChildren: parent. + children size = 1 ifTrue: [ "Should only be possible if parent is actual category with messages" + browser selectMessageCategoryNamed: parent. + self assert: browser messageList notEmpty]. + rest addAll: children]] ]! Item was added: + ----- Method: TreeBrowserTest>>testSysNoSingleChildWithEmptyParent (in category 'tests - system category list') ----- + testSysNoSingleChildWithEmptyParent + + | rest parent | + rest := browser systemCategoryRoots asOrderedCollection. + [rest notEmpty] whileTrue: [ + parent := rest removeFirst. + (browser systemCategoryHasChildren: parent) + ifTrue: [ | children | + children := browser systemCategoryChildren: parent. + children size = 1 ifTrue: [ "Should only be possible if parent is package or category with classes" + browser selectSystemCategory: parent. + self assert: (browser classList notEmpty + or: [(PackageOrganizer default packageNamed: parent ifAbsent: nil) notNil ])]. + rest addAll: children]]! Item was added: + ----- Method: TreeBrowserTest>>testSystemCategoryPath (in category 'tests - system category list') ----- + testSystemCategoryPath + "For any class, the end of the current should end in the actual system category." + + | failedSelections | + failedSelections := Set new. + SystemOrganization categories do: [:cat | + (SystemOrganization listAtCategoryNamed: cat) ifNotEmpty: [:classes | | cls | + cls := self environment classNamed: classes first. + browser setClass: cls. + cat == browser systemCategoryPath last + ifFalse: [failedSelections add: cat]]]. + self + assert: failedSelections isEmpty + description: 'Not all system categories can be selected!!'.!

1 0

The Trunk: Tools-mt.1198.mcz
by commits＠source.squeak.org 13 Apr '23

13 Apr '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1198.mcz ==================== Summary ==================== Name: Tools-mt.1198 Author: mt Time: 13 April 2023, 3:11:13.484682 pm UUID: 28e60f5f-f151-e74e-8651-4a3dae59a4a9 Ancestors: Tools-mt.1197 Adds and enables TreeBrowser, which is a variation of the default Browser with tree widgets in 3 of 4 panes. See its class comment. For a previous discussion, see: https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou… Disable it again via the preference wizard or: SystemBrowser default: Browser. Please report remaining issues and other questions. =============== Diff against Tools-mt.1197 =============== Item was added: + Browser subclass: #TreeBrowser + instanceVariableNames: 'parentCategories lastSystemCategoryList lastClassList lastMessageCategoryList isHierarchyMode classForHierarchy lastClassListIndentForHierarchy' + classVariableNames: 'ShowAllClassesInPackage ShowBlankClassIcons ShowEmptyPackages' + poolDictionaries: '' + category: 'Tools-Browser'! + + !TreeBrowser commentStamp: 'mt 4/13/2023 14:31' prior: 0! + Like a regular Smalltalk System Browser, I am a tool that helps explore and modify source code in the system. I am able to detect and show hierarchical structure in class (or system) categories, classes, and message categories (aka. protocols). The class hierarchy is formed by Smalltalk's single inheritance (i.e., #superclass and #subclasses). A hierarchy from any list of categories is derived by splitting dashes ("-") to reveal groups. Type-in filters are expected to work as in regular lists. + + Class (or system) categories, left-most pane: + - Synthetic groups have (parentheses) and are empty + - Groups that represent modified Monticello packages have an *asterisk + - Groups that represent packages can list all classes in it, see class-side preference + - Groups (or entries) that are just categories (i.e. no packages), are set in italic + - Type-in filter searches complete hierarchy, including collapsed items + + Class tree, second-from-left pane: + - Complete hierarchy expanded when selecting a different class category, except for "-- all --" category + - Type-in filter only searches visible items, not complete hierarchy, for better performance in "-- all --" category + - Blank icons disabled by default for better overview, see class-side preference + + Message categories (or protocols), third-from-left pane: + - Synthetic groups have (parentheses) and are empty + - All extensions grouped in "-- extensions --" category, which also aggregates all extension methods + - Type-in filter searches complete hierarchy, including collapsed items + + Note that a useful metaphor for category-hierarchies is the file system with its hierarchy of directories. Directories can be empty. Selecting a parent directory does not list the files of all sub-directories. While single-child paths are condensed for clarity, they can still occur when intermediate items are valid categories with content. + + I also have built-in support for showing a class hierarchy around a specific class, just like the HierarchyBrowser does. + I also have built-in support for traits, especially when in hierarchy-mode.! Item was added: + ----- Method: TreeBrowser class>>extensionCategory (in category 'defaults') ----- + extensionCategory + + ^ #'-- extensions --'! Item was added: + ----- Method: TreeBrowser class>>fullHierarchyOnClass: (in category 'instance creation') ----- + fullHierarchyOnClass: aClass + "Provide features from HierarchyBrowser within TreeBrowser." + + ^ self fullHierarchyOnClass: aClass selector: nil! Item was added: + ----- Method: TreeBrowser class>>fullHierarchyOnClass:selector: (in category 'instance creation') ----- + fullHierarchyOnClass: aClass selector: aSelector + "Provide features from HierarchyBrowser within TreeBrowser." + + ^ self new + buildAndOpenHierarchyBrowserLabel: 'Hierarchy Browser'; + initHierarchyFor: aClass "or trait"; + setSelector: aSelector; + yourself! Item was added: + ----- Method: TreeBrowser class>>hierarchyCategory (in category 'defaults') ----- + hierarchyCategory + + ^ #'-- hierarchy --'! Item was added: + ----- Method: TreeBrowser class>>newOnCategory:label: (in category 'instance creation') ----- + newOnCategory: aClassCategoryOrPackageName label: aLabel + "Overwritten to ignore artificial categories (including package names that are not a system category but only prefix)." + + ^ self new + selectSystemCategory: aClassCategoryOrPackageName asSymbol; + buildAndOpenCategoryBrowserLabel: aLabel; + yourself! Item was added: + ----- Method: TreeBrowser class>>showAllClassesInPackage (in category 'preferences') ----- + showAllClassesInPackage + <preference: 'Show all classes in a package in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, the entire class tree in a package will be shown in the class pane instead of the classes that belong to the respective system category, which is usually empty.' + type: #Boolean> + + ^ ShowAllClassesInPackage ifNil: [true]! Item was added: + ----- Method: TreeBrowser class>>showAllClassesInPackage: (in category 'preferences') ----- + showAllClassesInPackage: aBooleanOrNil + + ShowAllClassesInPackage == aBooleanOrNil ifTrue: [^ self]. + ShowAllClassesInPackage := aBooleanOrNil. + + self allInstancesDo: [:treeBrowser | treeBrowser updateClassTree].! Item was added: + ----- Method: TreeBrowser class>>showBlankClassIcons (in category 'preferences') ----- + showBlankClassIcons + <preference: 'Show blank class icons in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, classes with no distinct icon will get a blank icon, which makes such labels wider and might obfuscate hierarchy indication. Note that #showClassIcons must be enabled for this to have an effect.' + type: #Boolean> + + ^ ShowBlankClassIcons ifNil: [false]! Item was added: + ----- Method: TreeBrowser class>>showBlankClassIcons: (in category 'preferences') ----- + showBlankClassIcons: booleanOrNil + + ShowBlankClassIcons == booleanOrNil ifTrue: [^ self]. + (ShowBlankClassIcons := booleanOrNil) == true + ifTrue: [self showClassIcons: true]. + + self allInstancesDo: [:treeBrowser | treeBrowser changed: #classRoots].! Item was added: + ----- Method: TreeBrowser class>>showEmptyPackages (in category 'preferences') ----- + showEmptyPackages + <preference: 'Show extensions-only packages in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, apparently empty packages will be listed in the browser if those packages contain only extension methods in other classes. Users can still add classes to these packages or use the context menu to browse their extensions.' + type: #Boolean> + + ^ ShowEmptyPackages ifNil: [false]! Item was added: + ----- Method: TreeBrowser class>>showEmptyPackages: (in category 'preferences') ----- + showEmptyPackages: aBooleanOrNil + + ShowEmptyPackages == aBooleanOrNil ifTrue: [^ self]. + ShowEmptyPackages := aBooleanOrNil. + + self allInstancesDo: [:treeBrowser | treeBrowser updateSystemCategoryTree].! Item was added: + ----- Method: TreeBrowser>>allAncestorsOfClass: (in category 'extras - hierarchy browser - class tree') ----- + allAncestorsOfClass: class + + ^ self allAncestorsOfClass: class into: OrderedCollection new at: -1! Item was added: + ----- Method: TreeBrowser>>allAncestorsOfClass:into:at: (in category 'extras - hierarchy browser - class tree') ----- + allAncestorsOfClass: class into: collection at: depth + "See #allAncestorsOfClass:... in HierarchyBrowser." + + (class superclass ifNil: [#()] ifNotNil: [:c | {c}]), class traits + do: [:ancestor | + ancestor isTrait + ifTrue: [self allAncestorsOfTrait: ancestor into: collection at: depth - 1] + ifFalse: [self allAncestorsOfClass: ancestor into: collection at: depth - 1]. + collection add: ancestor. + lastClassListIndentForHierarchy add: depth]. + ^ collection! Item was added: + ----- Method: TreeBrowser>>allAncestorsOfTrait: (in category 'extras - hierarchy browser - class tree') ----- + allAncestorsOfTrait: trait + + ^ self allAncestorsOfTrait: trait into: OrderedCollection new at: -1! Item was added: + ----- Method: TreeBrowser>>allAncestorsOfTrait:into:at: (in category 'extras - hierarchy browser - class tree') ----- + allAncestorsOfTrait: trait into: collection at: depth + "See #allAncestorsOfTrait:... in HierarchyBrowser." + + trait traitComposition asTraitComposition traits + do: [:ancestor | + self allAncestorsOfTrait: ancestor into: collection at: depth - 1. + collection add: ancestor. + lastClassListIndentForHierarchy add: depth]. + ^ collection! Item was added: + ----- Method: TreeBrowser>>allClassCategories (in category 'system category tree - support') ----- + allClassCategories + + self isHierarchy ifTrue: [^ {} "pane should be invisible anyway"]. + + ^ self class showEmptyPackages + ifTrue: [systemOrganizer categories, PackageOrganizer default packageNames] + ifFalse: [systemOrganizer categories]! Item was added: + ----- Method: TreeBrowser>>allClassesForHierarchy (in category 'extras - hierarchy browser - class tree') ----- + allClassesForHierarchy + + | before after | + self flag: #hacky. "mt: See #updateTreeIfNeeded. Should work... hmpf..." + lastClassListIndentForHierarchy := OrderedCollection new. + + self flag: #environment. "mt: Check environment? Skip foreign classes?" + before := (classForHierarchy isTrait + ifTrue: [self allAncestorsOfTrait: classForHierarchy] + ifFalse: [self allAncestorsOfClass: classForHierarchy]). + lastClassListIndentForHierarchy add: 0. + after := (classForHierarchy isTrait + ifTrue: [self allSuccessorsOfTrait: classForHierarchy] + ifFalse: [self allSuccessorsOfClass: classForHierarchy]). + + ^ before, {classForHierarchy}, after! Item was added: + ----- Method: TreeBrowser>>allClassesInCategory (in category 'class tree - support') ----- + allClassesInCategory + "Answer a list of all class objects in the selected system category." + + self hasSystemCategorySelected ifFalse: [^ #()]. + self isHierarchy ifTrue: [^ self allClassesForHierarchy]. + + ^ self class showAllClassesInPackage + ifFalse: [self defaultClassList + collect: [:className | self environment classNamed: className] + thenSelect: [:classOrNil | classOrNil notNil "guard environment"]] + ifTrue: [PackageOrganizer default + packageNamed: selectedSystemCategory + ifPresent: [:pkg | pkg classes] + ifAbsent: [self defaultClassList + collect: [:className | self environment classNamed: className] + thenSelect: [:classOrNil | classOrNil notNil "guard environment"]]]! Item was added: + ----- Method: TreeBrowser>>allMessageCategories (in category 'message category tree - support') ----- + allMessageCategories + + ^ self hasClassSelected + ifFalse: [#()] + ifTrue: [self classOrMetaClassOrganizer categories]! Item was added: + ----- Method: TreeBrowser>>allSuccessorsOfClass: (in category 'extras - hierarchy browser - class tree') ----- + allSuccessorsOfClass: class + + ^ self allSuccessorsOfClass: class into: OrderedCollection new at: 1! Item was added: + ----- Method: TreeBrowser>>allSuccessorsOfClass:into:at: (in category 'extras - hierarchy browser - class tree') ----- + allSuccessorsOfClass: class into: collection at: depth + "See #allSuccessorsOfClass:... in HierarchyBrowser." + + (class subclasses sorted: #name ascending) + do: [:successor | + collection add: successor. + lastClassListIndentForHierarchy add: depth. + successor isTrait + ifTrue: [self allSuccessorsOfTrait: successor into: collection at: depth + 1] + ifFalse: [self allSuccessorsOfClass: successor into: collection at: depth + 1]]. + ^ collection! Item was added: + ----- Method: TreeBrowser>>allSuccessorsOfTrait: (in category 'extras - hierarchy browser - class tree') ----- + allSuccessorsOfTrait: trait + + ^ self allSuccessorsOfTrait: trait into: OrderedCollection new at: 1! Item was added: + ----- Method: TreeBrowser>>allSuccessorsOfTrait:into:at: (in category 'extras - hierarchy browser - class tree') ----- + allSuccessorsOfTrait: trait into: collection at: depth + "See #allSuccessorsOfTrait:... in HierarchyBrowser." + + (trait users "includes classes and traits" sorted: #name ascending) + do: [:successor | + collection add: successor. + lastClassListIndentForHierarchy add: depth. + successor isTrait + ifTrue: [self allSuccessorsOfTrait: successor into: collection at: depth + 1] + ifFalse: [self allSuccessorsOfClass: successor into: collection at: depth + 1]]. + ^ collection! Item was added: + ----- Method: TreeBrowser>>browseAllClasses (in category 'system category functions') ----- + browseAllClasses + + self class newOnCategory: SystemOrganizer allCategory.! Item was added: + ----- Method: TreeBrowser>>browseClassHierarchy (in category 'extras - hierarchy browser') ----- + browseClassHierarchy + + | pivot | + (pivot := self selectedClass) ifNil: [^ self]. + + self multiWindowState + ifNil: [ + self class fullHierarchyOnClass: pivot] + ifNotNil: [ + self multiWindowState addNewWindow. + self initHierarchyFor: pivot].! Item was added: + ----- Method: TreeBrowser>>buildAndOpenCategoryBrowserLabel: (in category 'toolbuilder') ----- + buildAndOpenCategoryBrowserLabel: aLabel + "Overwrite to replay certain interactive features that only work if the browser is already open." + + super buildAndOpenCategoryBrowserLabel: aLabel. + + self expandClassTree. + self changed: #classChild. + ! Item was added: + ----- Method: TreeBrowser>>buildAndOpenFullBrowser (in category 'toolbuilder') ----- + buildAndOpenFullBrowser + "Overwrite to replay certain interactive features that only work if the browser is already open." + + super buildAndOpenFullBrowser. + + self expandClassTree. + self changed: #classChild. + ! Item was added: + ----- Method: TreeBrowser>>buildAndOpenHierarchyBrowserLabel: (in category 'extras - hierarchy browser') ----- + buildAndOpenHierarchyBrowserLabel: aLabelString + + | builder windowSpec | + builder := ToolBuilder default. + + windowSpec := self buildHierarchyBrowserWith: builder. + aLabelString ifNotNil:[:str| windowSpec label: str]. + + builder open: windowSpec. + + ^self! Item was added: + ----- Method: TreeBrowser>>buildClassListWith: (in category 'toolbuilder') ----- + buildClassListWith: builder + + | tree | + tree := builder pluggableTreeSpec new. + tree + model: self; + roots: #classRoots; + label: #classLabel:; + getChildren: #classChildren:; + hasChildren: #classHasChildren:; + help: #classHelpAt:; + getSelectedPath: #classPath; + getSelected: #classChild; + setSelected: #classChild:; + icon: #classIcon:; + menu: #classListMenu:shifted:; + keyPress: #classListKey:from:; + filterMode: #visible; "not #all bc. class-tree is too deep, which makes filtering slow" + searchMode: #depthFirst. + SystemBrowser browseWithDragNDrop ifTrue: [ + tree + dragItem: #dragFromClassTree:; + dragType: #dragTypeForClassTreeAt:]. + ^ tree! Item was added: + ----- Method: TreeBrowser>>buildHierarchyBrowserWith: (in category 'extras - hierarchy browser') ----- + buildHierarchyBrowserWith: builder + + | max windowSpec | + max := self wantsOptionalButtons ifTrue:[0.32] ifFalse:[0.4]. + + windowSpec := self buildWindowWith: builder specs: { + (self classListFrame: max fromTop: 0 fromLeft: 0 width: 0.333) -> [self buildClassListWith: builder]. + (self switchesFrame: max fromLeft: 0 width: 0.333) -> [self buildSwitchesWith: builder]. + (LayoutFrame fractions: (0.333@0 corner: 0.666@max) offsets: (0@0 corner: 0@0)) -> [self buildMessageCategoryListWith: builder]. + (LayoutFrame fractions: (0.666@0 corner: 1@max) offsets: (0@0 corner: 0@0)) -> [self buildMessageListWith: builder]. + (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. + }. + self setMultiWindowFor:windowSpec. + + ^ builder build: windowSpec + ! Item was added: + ----- Method: TreeBrowser>>buildMessageCategoryListWith: (in category 'toolbuilder') ----- + buildMessageCategoryListWith: builder + + | tree | + tree := builder pluggableTreeSpec new. + tree + model: self; + roots: #messageCategoryRoots; + label: #messageCategoryLabel:; + getChildren: #messageCategoryChildren:; + hasChildren: #messageCategoryHasChildren:; + help: #messageCategoryHelpAt:; + getSelectedPath: #messageCategoryPath; + getSelected: #messageCategoryChild; + setSelected: #messageCategoryChild:; + menu: #messageCategoryMenu:; + keyPress: #messageCategoryListKey:from:; + filterMode: #all; + searchMode: #depthFirst. + SystemBrowser browseWithDragNDrop ifTrue:[ + tree + dropAccept: #wantsMessageCategoriesDrop:; + dropItem: #dropOnMessageCategories:on:]. + ^ tree! Item was added: + ----- Method: TreeBrowser>>buildSystemCategoryListWith: (in category 'toolbuilder') ----- + buildSystemCategoryListWith: builder + + | tree | + tree := builder pluggableTreeSpec new. + tree + model: self; + roots: #systemCategoryRoots; + label: #systemCategoryLabel:; + getChildren: #systemCategoryChildren:; + hasChildren: #systemCategoryHasChildren:; + help: #systemCategoryHelpAt:; + getSelectedPath: #systemCategoryPath; + getSelected: #systemCategoryChild; + setSelected: #systemCategoryChild:; + menu: #systemCategoryMenu:; + keyPress: #systemCatListKey:from:; + filterMode: #all; + searchMode: #depthFirst. + ^ tree! Item was added: + ----- Method: TreeBrowser>>changed: (in category 'updating') ----- + changed: aspect + + super changed: aspect. + + aspect == #systemCategoryList + ifTrue: [^ self updateSystemCategoryTree]. + aspect == #classList + ifTrue: [^ self updateClassTree]. + aspect == #messageCategoryList + ifTrue: [^ self updateMessageCategoryTree]. + + aspect == #systemCategoryListIndex + ifTrue: [^ self changed: #systemCategoryChild]. + aspect == #classListIndex + ifTrue: [^ self changed: #classChild]. + aspect == #messageCategoryListIndex + ifTrue: [^ self changed: #messageCategoryChild].! Item was added: + ----- Method: TreeBrowser>>classChild (in category 'class tree') ----- + classChild + + ^ self selectedClass! Item was added: + ----- Method: TreeBrowser>>classChild: (in category 'class tree') ----- + classChild: aClassNotMeta + + selectedClassName = aClassNotMeta name ifTrue: [^ self]. + self selectClass: aClassNotMeta. + self currentHand deleteBalloon.! Item was added: + ----- Method: TreeBrowser>>classChildren: (in category 'class tree') ----- + classChildren: aClass + + | all | + self selectedSystemCategory = SystemOrganizer allCategory + ifTrue: [^ aClass subclasses sortedSafely]. + self selectedSystemCategory = self class hierarchyCategory + ifTrue: [^ self classChildrenForHierarchy: aClass]. + + all := lastClassList. + + ^ all select: [:subclass | subclass superclass == aClass]! Item was added: + ----- Method: TreeBrowser>>classChildrenForHierarchy: (in category 'extras - hierarchy browser - class tree') ----- + classChildrenForHierarchy: classOrTraitOrNil + + | pos myIndent children currentIndent | + pos := lastClassList indexOf: classOrTraitOrNil ifAbsent: [0]. + pos = lastClassList size ifTrue: [^ #()]. + myIndent := lastClassListIndentForHierarchy + at: pos + ifAbsent: [lastClassListIndentForHierarchy first - 1]. + + children := OrderedCollection new. + pos := pos + 1. + [(currentIndent := lastClassListIndentForHierarchy at: pos ifAbsent: [myIndent]) <= myIndent] + whileFalse: [ + currentIndent = (myIndent+1 "direct child") + ifTrue: [children add: (lastClassList at: pos)]. + pos := pos + 1]. + ^ children! Item was added: + ----- Method: TreeBrowser>>classHasChildren: (in category 'class tree') ----- + classHasChildren: aClass + + aClass == Class "... ProtoObject class ..." + ifTrue: [^ false]. + self selectedSystemCategory = SystemOrganizer allCategory + ifTrue: [^ aClass subclasses notEmpty]. + self selectedSystemCategory = self class hierarchyCategory + ifTrue: [^ self classHasChildrenForHierarchy: aClass]. + ^ lastClassList includesAnyOf: aClass subclasses! Item was added: + ----- Method: TreeBrowser>>classHasChildrenForHierarchy: (in category 'extras - hierarchy browser - class tree') ----- + classHasChildrenForHierarchy: classOrTrait + + | pos indent | + pos := lastClassList indexOf: classOrTrait. + pos = lastClassList size ifTrue: [^ false]. + indent := lastClassListIndentForHierarchy at: pos. + ^ (lastClassListIndentForHierarchy at: pos+1 "first child?") = (indent+1)! Item was added: + ----- Method: TreeBrowser>>classHelpAt: (in category 'class tree - support') ----- + classHelpAt: aClass + "Shorten unformatted string representation to for better performance of longer comments." + + ^ aClass organization classComment + ifNotEmpty: [:comment | self messageHelpTruncated: (comment asString withNoLineLongerThan: 60) asText] + ifEmpty: [nil]! Item was added: + ----- Method: TreeBrowser>>classIcon: (in category 'class tree') ----- + classIcon: aClass + "Answer 'nil' instead of blank icon to keep the tree widget compact." + + | iconName | + self class showClassIcons + ifFalse: [^ nil]. + + ^ ((iconName := ToolIcons iconForClass: aClass name) ~~ #blank or: [ShowBlankClassIcons == true]) + ifTrue: [ToolIcons iconNamed: iconName]! Item was added: + ----- Method: TreeBrowser>>classLabel: (in category 'class tree') ----- + classLabel: aClassOrTrait + + self selectedSystemCategory = self class hierarchyCategory + ifTrue: [^ self classLabelForHierarchy: aClassOrTrait]. + + ^ aClassOrTrait isTrait + ifTrue: [aClassOrTrait name asText addAttribute: TextEmphasis italic] + ifFalse: [aClassOrTrait name]! Item was added: + ----- Method: TreeBrowser>>classLabelForHierarchy: (in category 'extras - hierarchy browser - class tree') ----- + classLabelForHierarchy: classOrTrait + "Emphasize what is different from the hierarchy's current center." + + ^ classForHierarchy == classOrTrait + ifTrue: [classOrTrait name asText addAttribute: TextEmphasis bold] + ifFalse: [classForHierarchy isTrait == classOrTrait isTrait + ifTrue: [classOrTrait name] + ifFalse: [classOrTrait name asText addAttribute: TextEmphasis italic]]! Item was added: + ----- Method: TreeBrowser>>classListKey:from: (in category 'class tree - support') ----- + classListKey: aChar from: view + "Overwritten because tree widgets do not check whether a modifier key was pressed..." + + ^ self currentEvent anyModifierKeyPressed + and: [super classListKey: aChar from: view]! Item was added: + ----- Method: TreeBrowser>>classPath (in category 'class tree') ----- + classPath + + self selectedSystemCategory = self class hierarchyCategory + ifTrue: [^ self classPathForHierarchy]. + + ^ self selectedClass ifNotNil: [:cls | + | roots shouldAdd | + roots := self classRoots asSet. + shouldAdd := true. + (Array streamContents: [:s | + cls withAllSuperclassesDo: [:ea | + shouldAdd ifTrue: [s nextPut: ea]. + (roots includes: ea) + ifTrue: [shouldAdd := false]]]) + reversed]! Item was added: + ----- Method: TreeBrowser>>classPathForHierarchy (in category 'extras - hierarchy browser - class tree') ----- + classPathForHierarchy + + ^ self selectedClass ifNotNil: [:classOrTrait | + | pos firstIndent indent path | + firstIndent := lastClassListIndentForHierarchy at: 1. + path := OrderedCollection with: classOrTrait. + + pos := lastClassList indexOf: classOrTrait. + indent := lastClassListIndentForHierarchy at: pos. + + [pos > 1 and: [indent > firstIndent]] whileTrue: [ + [(lastClassListIndentForHierarchy at: pos) < indent] + whileFalse: [pos := pos - 1]. + path addFirst: (lastClassList at: pos). + indent := lastClassListIndentForHierarchy at: pos]. + + path]! Item was added: + ----- Method: TreeBrowser>>classRoots (in category 'class tree') ----- + classRoots + + | all | + self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ {ProtoObject}]. + self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classRootsForHierarchy]. + + all := lastClassList. + + ^ all select: [:class | all noneSatisfy: [:ea | class inheritsFrom: ea]]! Item was added: + ----- Method: TreeBrowser>>classRootsForHierarchy (in category 'extras - hierarchy browser - class tree') ----- + classRootsForHierarchy + + ^ self classChildrenForHierarchy: nil! Item was added: + ----- Method: TreeBrowser>>contents:notifying: (in category 'accessing') ----- + contents: input notifying: aController + "Overwritten to indicate uncommitted (MC) changes in the package nodes in the system-category tree." + + ^ (super contents: input notifying: aController) + ifTrue: [self changed: #systemCategoryLabel:. true] + ifFalse: [false]! Item was added: + ----- Method: TreeBrowser>>defaultBrowserTitle (in category 'initialization') ----- + defaultBrowserTitle + + ^ self isHierarchy + ifTrue: ['Hierarchy Browser'] + ifFalse: [super defaultBrowserTitle]! Item was added: + ----- Method: TreeBrowser>>dragFromClassTree: (in category 'class tree - support') ----- + dragFromClassTree: aClass + + ^ aClass! Item was added: + ----- Method: TreeBrowser>>dragTypeForClassTreeAt: (in category 'class tree - support') ----- + dragTypeForClassTreeAt: aClass + + ^ #sourceCode! Item was added: + ----- Method: TreeBrowser>>dropOnMessageCategories:on: (in category 'message category tree - support') ----- + dropOnMessageCategories: method on: child + + ^ self + dropOnMessageCategories: method + at: (self messageCategoryList indexOf: child)! Item was added: + ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- + expandClassTree + "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." + + self selectedSystemCategory = SystemOrganizer allCategory + ifFalse: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]] + ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}].! Item was added: + ----- Method: TreeBrowser>>findPrefix: (in category 'category to hierarchy') ----- + findPrefix: aString + + ^ self findPrefix: aString startingAt: 1! Item was added: + ----- Method: TreeBrowser>>findPrefix:startingAt: (in category 'category to hierarchy') ----- + findPrefix: aString startingAt: start + + | pos | + ^ (pos := aString findString: '-' startingAt: start+1) > 0 + ifTrue: [(aString copyFrom: 1 to: pos-1) asSymbol] + ifFalse: [nil]! Item was added: + ----- Method: TreeBrowser>>findSuffix: (in category 'category to hierarchy') ----- + findSuffix: category + + | first | + first := (parentCategories at: category ifAbsent: ['']) size. + first = 0 ifTrue: [^ category]. + ^ category copyFrom: first+2 to: category size! Item was added: + ----- Method: TreeBrowser>>findTrimmedPrefix: (in category 'category to hierarchy') ----- + findTrimmedPrefix: aString + + ^ self findTrimmedPrefix: aString startingAt: 1! Item was added: + ----- Method: TreeBrowser>>findTrimmedPrefix:startingAt: (in category 'category to hierarchy') ----- + findTrimmedPrefix: aString startingAt: start + + | pos first | + first := start. + [(aString at: first) isSeparator] whileTrue: [first := first + 1]. + ^ (pos := aString findString: '-' startingAt: first+1) > 0 + ifTrue: [(aString copyFrom: 1 to: pos-1) withBlanksTrimmed asSymbol] + ifFalse: [nil]! Item was added: + ----- Method: TreeBrowser>>findTrimmedSuffix: (in category 'category to hierarchy') ----- + findTrimmedSuffix: category + + | first | + first := (parentCategories at: category ifAbsent: ['']) size + 1. + first = 1 ifTrue: [^ category]. + [(category at: first) isSeparator] whileTrue: [first := first + 1]. + first := first + 1. + [(category at: first) isSeparator] whileTrue: [first := first + 1]. + ^ category copyFrom: first to: category size! Item was added: + ----- Method: TreeBrowser>>for:from:anyVariations: (in category 'category to hierarchy') ----- + for: category from: allCategories anyVariations: findBlock + "Answer whether there is more than one sub-category in allCategories given the prefix category." + + | variations prefixSize | + variations := Set new. + prefixSize := category size + 1. + + prefixSize > 2 ifFalse: [^ false "e-toy ..."]. + + allCategories do: [:each | + (findBlock value: each value: prefixSize) + ifNotNil: [:prefix | variations add: prefix] + ifNil: [variations add: each asSymbol]. + variations size > 1 ifTrue: [^ true]]. + + ^ false! Item was added: + ----- Method: TreeBrowser>>for:from:count: (in category 'category to hierarchy') ----- + for: category from: allCategories count: findBlock + + | variations prefixSize | + variations := Set new. + prefixSize := category size + 1. + + allCategories do: [:each | + (findBlock value: each value: prefixSize) + ifNotNil: [:prefix | variations add: prefix] + ifNil: [variations add: each asSymbol]]. + + ^ variations size! Item was added: + ----- Method: TreeBrowser>>for:from:select:thenCollect: (in category 'category to hierarchy') ----- + for: category from: allCategories select: predicateBlock thenCollect: findBlock + "For the given category looking through allCategories, find sub-categories via findBlock if predicateBlock matches that category as an actual prefix. See #findPrefix: and #findTrimmedPrefix:. Try to avoid single children." + + | frequencies prefixSize result completed matches | + frequencies := Bag new. + completed := Set new. + matches := Dictionary new. + prefixSize := category size + 1. + + allCategories do: [:each | + (predicateBlock value: category value: each) ifTrue: [ + (findBlock value: each value: prefixSize) + ifNotNil: [:prefix | + frequencies add: prefix. + (matches at: prefix ifAbsentPut: [OrderedCollection new]) add: each] + ifNil: [ + frequencies add: each asSymbol. + completed add: each asSymbol]]]. + + result := OrderedCollection new: frequencies size + completed size. + frequencies valuesAndCounts keysAndValuesDo: [:prefix :amount | + amount > 1 + ifTrue: [ + ((completed includes: prefix) or: [self for: prefix from: (matches at: prefix) anyVariations: findBlock]) + ifTrue: ["Multiple children. Best case for overview." + parentCategories at: prefix put: category. + result add: prefix] + ifFalse: ["Multiple children with single child next level. Look further." + | miniPaths | + miniPaths := self for: prefix from: (matches at: prefix) + select: predicateBlock + thenCollect: findBlock. + miniPaths do: [:each | parentCategories at: each put: category]. + result addAll: miniPaths]] + ifFalse: [ + (completed includes: prefix) + ifTrue: ["Single child. Okay, because already complete." + parentCategories at: prefix put: category. + result add: prefix] + ifFalse: ["Single child. Look further." + | miniPaths | + miniPaths := self for: prefix from: (matches at: prefix) + select: predicateBlock + thenCollect: findBlock. + miniPaths do: [:each | parentCategories at: each put: category]. + result addAll: miniPaths]]]. + + ^ result sorted! Item was added: + ----- Method: TreeBrowser>>hasMessageCategory:prefix: (in category 'category to hierarchy') ----- + hasMessageCategory: category prefix: prefix + "Like #beginsWith: but check for a trailing separator, ignoring whitespace" + + prefix ifEmpty: [^ true]. + (category beginsWith: prefix) ifFalse: [^ false]. + prefix size + 1 to: category size do: [:index | | char | + (char := category at: index) == $- ifTrue: [^ true]. + char isSeparator ifFalse: [^ false]]. + ^ false! Item was added: + ----- Method: TreeBrowser>>hasSystemCategory:prefix: (in category 'category to hierarchy') ----- + hasSystemCategory: category prefix: prefix + + ^ prefix isEmpty or: [ + (category at: prefix size + 1 ifAbsent: nil) == $- + and: [category beginsWith: prefix]]! Item was added: + ----- Method: TreeBrowser>>initHierarchyFor: (in category 'extras - hierarchy browser') ----- + initHierarchyFor: classOrTrait + + self setHierarchyMode. + classForHierarchy := classOrTrait. + + self updateSystemCategoryTree. + self selectSystemCategory: self class hierarchyCategory. + + self updateClassTree. + self selectClass: classForHierarchy. "Must not use #setClass: here."! Item was added: + ----- Method: TreeBrowser>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + parentCategories := Dictionary new. + + lastSystemCategoryList := #(). + lastClassList := #(). + lastMessageCategoryList := #().! Item was added: + ----- Method: TreeBrowser>>isHierarchy (in category 'extras - hierarchy browser') ----- + isHierarchy + "Note that this hook was also introduced for multi-window support. See superclass." + + ^ isHierarchyMode == true! Item was added: + ----- Method: TreeBrowser>>messageCategoryChild (in category 'message category tree') ----- + messageCategoryChild + + ^ selectedMessageCategoryName! Item was added: + ----- Method: TreeBrowser>>messageCategoryChild: (in category 'message category tree') ----- + messageCategoryChild: aSymbol + + selectedMessageCategoryName = aSymbol ifTrue: [^ self]. + self selectMessageCategoryNamed: aSymbol. + self currentHand deleteBalloon.! Item was added: + ----- Method: TreeBrowser>>messageCategoryChildren: (in category 'message category tree') ----- + messageCategoryChildren: category + + | all | + category = ClassOrganizer allCategory ifTrue: [^ #()]. + + all := (category = self class extensionCategory or: [category notEmpty and: [category first == $*]]) + ifTrue: [lastMessageCategoryList select: [:cat | cat first == $*]] + ifFalse: [lastMessageCategoryList reject: [:cat | cat first == $*]]. + + ^ self + for: (category = self class extensionCategory + ifTrue: [''] ifFalse: [category]) + from: all + select: [:prefix :cat | self hasMessageCategory: cat prefix: prefix] + thenCollect: [:cat :start | self findTrimmedPrefix: cat startingAt: start]! Item was added: + ----- Method: TreeBrowser>>messageCategoryHasChildren: (in category 'message category tree') ----- + messageCategoryHasChildren: category + + | predicate | + category == ClassOrganizer allCategory ifTrue: [^ false]. + + predicate := category == self class extensionCategory + ifTrue: [ [:cat | cat first == $*] ] + ifFalse: [ [:cat | self hasMessageCategory: cat prefix: category] ]. + + ^ lastMessageCategoryList anySatisfy: [:cat | predicate value: cat]! Item was added: + ----- Method: TreeBrowser>>messageCategoryHelpAt: (in category 'message category tree - support') ----- + messageCategoryHelpAt: category + + ^ (self messageCategoryLabel: category) = category + ifFalse: [category]! Item was added: + ----- Method: TreeBrowser>>messageCategoryLabel: (in category 'message category tree') ----- + messageCategoryLabel: category + + | label | + category = ClassOrganizer allCategory ifTrue: [^ category]. + category = self class extensionCategory ifTrue: [^ category]. + + label := self findTrimmedSuffix: category. + + (self classOrMetaClassOrganizer categories includes: category) + ifFalse: [ + label := '(', label, ')']. + + ^ label! Item was added: + ----- Method: TreeBrowser>>messageCategoryListKey:from: (in category 'message category tree - support') ----- + messageCategoryListKey: aChar from: view + "Overwriten because tree widgets do not check whether a modifier key was pressed..." + + ^ self currentEvent anyModifierKeyPressed + and: [super messageCategoryListKey: aChar from: view]! Item was added: + ----- Method: TreeBrowser>>messageCategoryPath (in category 'message category tree') ----- + messageCategoryPath + "Answer the path represented by the category. Ensure to fill the cache." + + self hasClassSelected ifFalse: [^ #()]. + self hasMessageCategorySelected ifFalse: [^ #()]. + + selectedMessageCategoryName = ClassOrganizer allCategory ifTrue: [^ {selectedMessageCategoryName}]. + selectedMessageCategoryName = self class extensionCategory ifTrue: [^ {selectedMessageCategoryName}]. + + ^ Array streamContents: [:s | | parent | + selectedMessageCategoryName first == $* "Is extension category?" + ifTrue: [s nextPut: (parent := self class extensionCategory)] + ifFalse: [parent := '']. + [parent notNil] whileTrue: [ + (self messageCategoryChildren: parent) + detect: [:ea | selectedMessageCategoryName beginsWith: ea] + ifFound: [:ea | s nextPut: (parent := ea)] + ifNone: [parent := nil]]]! Item was added: + ----- Method: TreeBrowser>>messageCategoryRoots (in category 'message category tree') ----- + messageCategoryRoots + + | hasExtensions hasAny roots | + self hasClassSelected ifFalse: [^ Array new]. + + hasAny := self classOrMetaClassOrganizer isEmpty not. + hasExtensions := self classOrMetaClassOrganizer categories + anySatisfy: [:cat | cat first == $*]. + + roots := OrderedCollection new. + hasAny ifTrue: [roots add: ClassOrganizer allCategory]. + hasExtensions ifTrue: [roots add: self class extensionCategory]. + + roots addAll: (self messageCategoryChildren: ''). + + ^ roots! Item was added: + ----- Method: TreeBrowser>>messageList (in category 'message list') ----- + messageList + "Overwritten to show all extensions when the '-- extensions --' category is selected." + + ^ self selectedMessageCategoryName = self class extensionCategory + ifFalse: [super messageList] + ifTrue: [ + Array streamContents: [:extensionSelectors | + self classOrMetaClassOrganizer categories + select: [:cat | cat first == $*] + thenDo: [:extCat | (self classOrMetaClassOrganizer listAtCategoryNamed: extCat) + do: [:extSel | extensionSelectors nextPut: (self formattedLabel: extSel)]]]]! Item was added: + ----- Method: TreeBrowser>>newClassContents (in category 'extras - hierarchy browser') ----- + newClassContents + "Overwritten to use category of hierarchy-class for new class." + + | theClassName | + self isHierarchy ifFalse: [^ super newClassContents]. + ^ (theClassName := self selectedClassName) + ifNil: [Class template: classForHierarchy category] + ifNotNil: [Class templateForSubclassOf: theClassName asString category: classForHierarchy category]! Item was added: + ----- Method: TreeBrowser>>restoreToCategory:className:protocol:selector:mode:meta: (in category 'extras - multi-window support') ----- + restoreToCategory: category className: className protocol: protocol selector: selector mode: editMode meta: metaBool + + lastSystemCategoryList := #(). + lastClassList := #(). + lastMessageCategoryList := #(). + + self updateTreesIfNeeded. + + super restoreToCategory: category className: className protocol: protocol selector: selector mode: editMode meta: metaBool.! Item was added: + ----- Method: TreeBrowser>>selectEnvironment: (in category 'initialization') ----- + selectEnvironment: anEnvironment + + super selectEnvironment: anEnvironment. + + lastSystemCategoryList := self allClassCategories.! Item was added: + ----- Method: TreeBrowser>>setHierarchyMode (in category 'extras - hierarchy browser') ----- + setHierarchyMode + "Mimic what HierarchyBrowser does. Configure the receiver to only display an inheritance tree around a specific class. That is, all superclasses of that class and *all* of its specializations. From now on, there will be no class categories visible in the left-most pane even if the toolbuilder constructed a pane for that. See #newHierarchyFor:selector: for a way to open the receiver without that class-category pane." + + isHierarchyMode := true.! Item was added: + ----- Method: TreeBrowser>>spawnOrNavigateTo: (in category 'extras - hierarchy browser') ----- + spawnOrNavigateTo: aClass + + (aClass inheritsFrom: classForHierarchy) + ifTrue: [ super spawnOrNavigateTo: aClass ] + ifFalse: [ self systemNavigation browseHierarchy: aClass ].! Item was added: + ----- Method: TreeBrowser>>systemCatListKey:from: (in category 'system category tree - support') ----- + systemCatListKey: aChar from: view + "Overwriten because tree widgets do not check whether a modifier key was pressed..." + + ^ self currentEvent anyModifierKeyPressed + and: [super systemCatListKey: aChar from: view]! Item was added: + ----- Method: TreeBrowser>>systemCatSingletonKey:from: (in category 'system category tree - support') ----- + systemCatSingletonKey: aChar from: aView + + ^ super systemCatSingletonKey: aChar from: aView! Item was added: + ----- Method: TreeBrowser>>systemCategoryChild (in category 'system category tree') ----- + systemCategoryChild + + ^ selectedSystemCategory! Item was added: + ----- Method: TreeBrowser>>systemCategoryChild: (in category 'system category tree') ----- + systemCategoryChild: aSymbol + + aSymbol = selectedSystemCategory ifTrue: [^ self]. + self selectSystemCategory: aSymbol. + self currentHand deleteBalloon.! Item was added: + ----- Method: TreeBrowser>>systemCategoryChildren: (in category 'system category tree') ----- + systemCategoryChildren: category + + | all | + category == SystemOrganizer allCategory ifTrue: [^ #()]. + category == self class hierarchyCategory ifTrue: [^ #() "#systemCategoryChildrenForHierarchy:"]. + + all := lastSystemCategoryList. + + ^ self + for: category + from: all + select: [:prefix :cat | self hasSystemCategory: cat prefix: prefix] + thenCollect: [:cat :start | self findPrefix: cat startingAt: start]! Item was added: + ----- Method: TreeBrowser>>systemCategoryHasChildren: (in category 'system category tree') ----- + systemCategoryHasChildren: category + + category == SystemOrganizer allCategory ifTrue: [^ false]. + category == self class hierarchyCategory ifTrue: [^ false "#systemCategoryHasChildrenForHierarchy:"]. + + ^ lastSystemCategoryList anySatisfy: [:cat | self hasSystemCategory: cat prefix: category]! Item was added: + ----- Method: TreeBrowser>>systemCategoryHelpAt: (in category 'system category tree - support') ----- + systemCategoryHelpAt: category + "Integrate Monticello by informing users about package repositories and modifications." + + ^ PackageOrganizer default + packageNamed: category + ifPresent: [:pkg | + Text streamContents: [:packageHelp | | wc repos | + wc := pkg workingCopy. + packageHelp + nextPutAll: ('This is a{1} package:' translated + format: {wc modified ifTrue: [' <b>modified</b>'] ifFalse: ['']}) asTextFromHtml; + cr; space; nextPutAll: (wc := pkg workingCopy) description. + (repos := wc repositoryGroup repositories) size > 1 "more than cache" ifTrue: [ + packageHelp + cr; cr; nextPutAll: 'Known repositories:' translated. + 2 to: repos size do: [:index | | repo | + repo := repos at: index. + packageHelp cr; space; nextPutAll: repo description]] ]] + ifAbsent: [(SystemOrganization categories includes: category) + ifTrue: [category]] + ! Item was added: + ----- Method: TreeBrowser>>systemCategoryLabel: (in category 'system category tree') ----- + systemCategoryLabel: category + "Integrate Monticello by informing users about package modifications." + + | label | + category = SystemOrganizer allCategory ifTrue: [^ category]. + category = self class hierarchyCategory ifTrue: [^ category "#systemCategoryLabelForHierarchy:"]. + + label := self findSuffix: category. + + PackageOrganizer default + packageNamed: category + ifPresent: [:pkg | pkg workingCopy modified ifTrue: [label := '* ', label]] + ifAbsent: [ + (PackageOrganizer default + packageOfSystemCategory: category + ifNone: nil) + ifNil: [ + (SystemOrganization categories includes: category) + ifTrue: [label := label asText addAttribute: TextEmphasis italic; yourself] + ifFalse: [label := '(', label, ')'" asText addAttribute: TextColor gray; yourself"]] + ifNotNil: [ + self flag: #performance. + (SystemOrganization categories includes: category) + ifFalse: [label := '(', label, ')']. + label := label asText addAttribute: TextEmphasis italic; yourself.]] + . + + ^ label! Item was added: + ----- Method: TreeBrowser>>systemCategoryPath (in category 'system category tree') ----- + systemCategoryPath + + self hasSystemCategorySelected ifFalse: [^ #()]. + selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ {selectedSystemCategory}]. + selectedSystemCategory = self class hierarchyCategory ifTrue: [^ {selectedSystemCategory} "#systemCategoryPathForHierarchy:"]. + + ^ Array streamContents: [:s | | parent | + parent := ''. + [parent notNil] whileTrue: [ + (self systemCategoryChildren: parent) + detect: [:ea | (self hasSystemCategory: selectedSystemCategory prefix: ea) + or: [selectedSystemCategory == ea]] + ifFound: [:ea | s nextPut: (parent := ea)] + ifNone: [parent := nil]]]! Item was added: + ----- Method: TreeBrowser>>systemCategoryRoots (in category 'system category tree') ----- + systemCategoryRoots + + ^ self isHierarchy + ifTrue: [{SystemOrganizer allCategory. self class hierarchyCategory} "#systemCategoryRootsForHierarchy"] + ifFalse: [{SystemOrganizer allCategory}, (self systemCategoryChildren: '')]! Item was added: + ----- Method: TreeBrowser>>systemOrganizer: (in category 'initialization') ----- + systemOrganizer: aSystemOrganizer + + super systemOrganizer: aSystemOrganizer. + + lastSystemCategoryList := self allClassCategories.! Item was added: + ----- Method: TreeBrowser>>updateClassTree (in category 'updating') ----- + updateClassTree + + self updateClassTree: self allClassesInCategory.! Item was added: + ----- Method: TreeBrowser>>updateClassTree: (in category 'updating') ----- + updateClassTree: newList + + lastClassList := newList. + self changed: #classRoots. + self expandClassTree. + + self changed: #classChild.! Item was added: + ----- Method: TreeBrowser>>updateListsAndCodeIn: (in category 'updating') ----- + updateListsAndCodeIn: aWindow + + super updateListsAndCodeIn: aWindow. + self updateTreesIfNeeded.! Item was added: + ----- Method: TreeBrowser>>updateMessageCategoryTree (in category 'updating') ----- + updateMessageCategoryTree + + self updateMessageCategoryTree: self allMessageCategories.! Item was added: + ----- Method: TreeBrowser>>updateMessageCategoryTree: (in category 'updating') ----- + updateMessageCategoryTree: newList + + lastMessageCategoryList := newList. + self changed: #messageCategoryRoots.! Item was added: + ----- Method: TreeBrowser>>updateSystemCategoryTree (in category 'updating') ----- + updateSystemCategoryTree + + self updateSystemCategoryTree: self allClassCategories.! Item was added: + ----- Method: TreeBrowser>>updateSystemCategoryTree: (in category 'updating') ----- + updateSystemCategoryTree: newList + + lastSystemCategoryList := newList. + self changed: #systemCategoryRoots. + self changed: #systemCategoryChild. "For expanding new paths."! Item was added: + ----- Method: TreeBrowser>>updateTreesIfNeeded (in category 'updating') ----- + updateTreesIfNeeded + + | tmp | + lastSystemCategoryList = (tmp := self allClassCategories) + ifFalse: [self updateSystemCategoryTree: tmp]. + lastClassList = (tmp := self allClassesInCategory) + ifFalse: [self updateClassTree: tmp]. + lastMessageCategoryList = (tmp := self allMessageCategories) + ifFalse: [self updateMessageCategoryTree: tmp].! Item was changed: + (PackageInfo named: 'Tools') postscript: 'SystemBrowser default: TreeBrowser.'! - (PackageInfo named: 'Tools') postscript: 'ToolIcons icons removeKey: #font ifAbsent: []. - - "Update description of the preference #extraDebuggerButtons (Tools-ct.1128)" - (Preferences preferenceAt: #extraDebuggerButtons) instVarNamed: ''helpString'' put: ''If true, debugger windows will show *two* rows of buttons -- the debugger-specific row (proceed, restart, etc.) and also the conventional code-tools row. This preference overrides the "Optional buttons" preference for debuggers.''.'!

1 0

The Treated Inbox: JSON-ul.56.mcz
by commits＠source.squeak.org 11 Apr '23

11 Apr '23

Levente Uzonyi uploaded a new version of JSON to project The Treated Inbox: http://source.squeak.org/treated/JSON-ul.56.mcz ==================== Summary ==================== Name: JSON-ul.56 Author: ul Time: 6 December 2020, 6:47:32.838453 pm UUID: 6c5f17b1-830e-45ba-90b0-3cd6d40cd35e Ancestors: JSON-ul.55 Implemented JsonObject >> #respondsTo: which returns true for all setters and getters of already defined fields. The code works the same way #doesNotUnderstand: does. =============== Diff against JSON-ul.55 =============== Item was added: + ----- Method: JsonObject>>respondsTo: (in category 'error handling') ----- + respondsTo: aSymbol + + | precedence | + (super respondsTo: aSymbol) ifTrue: [ ^true ]. + (precedence := aSymbol precedence) = 1 ifTrue: [ + ^self includesKey: aSymbol ]. + (precedence = 3 and: [ (aSymbol indexOf: $:) = aSymbol size ]) ifTrue: [ + ^self includesKey: aSymbol allButLast ]. + ^false!

1 0

The Treated Inbox: WebClient-Core-ul.131.mcz
by commits＠source.squeak.org 11 Apr '23

11 Apr '23

Levente Uzonyi uploaded a new version of WebClient-Core to project The Treated Inbox: http://source.squeak.org/treated/WebClient-Core-ul.131.mcz ==================== Summary ==================== Name: WebClient-Core-ul.131 Author: ul Time: 11 April 2023, 12:48:04.515814 pm UUID: c3fedba8-7684-4223-802c-e699cbfb4c84 Ancestors: WebClient-Core-mt.130 Speed up MD5 computation in WebUtils: - as suggested by Tim, #md5HashStream: returns the bytes in the output order, so #reversed can be skipped (this is a breaking change for all the senders of WebUtils class >> #md5HashStream:) - use #readInto:startingAt:count: instead of #nextInto: to read from the stream into the buffer. This avoids a few sends and potential reallocation of the buffer. - do not convert the ByteString to ByteArray in #md5Digest:. ByteArray >> #replaceFrom:to:with:startingAt: can copy from a ByteString into the buffer. Throughput increases by 28% for 16k inputs. =============== Diff against WebClient-Core-mt.130 =============== Item was changed: ----- Method: WebUtils class>>md5Digest: (in category 'md5') ----- md5Digest: aStringOrByteArray "This creates a little endian hex string to be used with various auth methods This is the same as htdigest (apache) uses for its md5 digest auth db" + ^(self md5HashStream: aStringOrByteArray readStream) hex! - ^(self md5HashStream: (ReadStream on: aStringOrByteArray asByteArray)) reversed hex! Item was changed: ----- Method: WebUtils class>>md5HashStream: (in category 'md5') ----- md5HashStream: aStream "self md5HashStream: (ReadStream on: 'foo')" | start buffer chunkSize n words hash | hash := WordArray with: 16r67452301 with: 16rEFCDAB89 with: 16r98BADCFE with: 16r10325476. words := WordArray new: 16. buffer := ByteArray new: 64. start := aStream position. [ + chunkSize := aStream readInto: buffer startingAt: 1 count: 64. - chunkSize := (aStream nextInto: buffer) size. chunkSize < 64 or: [ aStream atEnd ] ] whileFalse: [ 1 to: 16 do:[:i| words at: i put: (buffer unsignedLongAt: i*4-3 bigEndian: false)]. self md5Transform: words hash: hash ]. buffer from: chunkSize +1 to: buffer size put: 0. chunkSize < 56 ifTrue: [ buffer at: chunkSize + 1 put: 128. "trailing bit" ] ifFalse:[ "not enough room for the length, so just pad this one, then..." chunkSize < 64 ifTrue:[buffer at: chunkSize + 1 put: 128]. 1 to: 16 do:[:i| words at: i put: (buffer unsignedLongAt: i*4-3 bigEndian: false)]. self md5Transform: words hash: hash. "process one additional block of padding ending with the length" buffer atAllPut: 0. chunkSize = 64 ifTrue: [buffer at: 1 put: 128]. ]. "Fill in the final 8 bytes with the 64-bit length in bits." n := (aStream position - start) * 8. 7 to: 0 by: -1 do:[:i| buffer at: (buffer size - i) put: ((n bitShift: 7 - i * -8) bitAnd: 255)]. "Final round" 1 to: 16 do:[:i| words at: i put: (buffer unsignedLongAt: i*4-3 bigEndian: false)]. self md5Transform: words hash: hash. ^(ByteArray new: 16) + unsignedLongAt: 1 put: (hash at: 1) bigEndian: false; + unsignedLongAt: 5 put: (hash at: 2) bigEndian: false; + unsignedLongAt: 9 put: (hash at: 3) bigEndian: false; + unsignedLongAt: 13 put: (hash at: 4) bigEndian: false; - unsignedLongAt: 1 put: (hash at: 4) bigEndian: true; - unsignedLongAt: 5 put: (hash at: 3) bigEndian: true; - unsignedLongAt: 9 put: (hash at: 2) bigEndian: true; - unsignedLongAt: 13 put: (hash at: 1) bigEndian: true; yourself! Item was changed: ----- Method: WebUtils class>>webSocketHandshake:with:with: (in category 'websockets') ----- webSocketHandshake: key1 with: key2 with: data "Do the actual WebSocket handshake computation" | bytes | bytes := ByteArray new: 16. bytes longAt: 1 put: key1 bigEndian: true. bytes longAt: 5 put: key2 bigEndian: true. bytes replaceFrom: 9 to: 16 with: data. + ^self md5HashStream: bytes readStream! - ^(self md5HashStream: bytes readStream) reversed!

1 0

The Trunk: Tools-mt.1197.mcz
by commits＠source.squeak.org 11 Apr '23

11 Apr '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1197.mcz ==================== Summary ==================== Name: Tools-mt.1197 Author: mt Time: 11 April 2023, 11:03:12.65283 am UUID: a5846202-532b-b44e-803d-4277997b1383 Ancestors: Tools-mt.1196 For custom browsers, simplify extension point for hierarchy-browsing by letting only the Browser class know of its current HierarchyBrowser specialization. StandardToolSet and SystemBrowser (i.e., app registry) only pre-scribe class-side protocol, which is here: #fullHierarchyOnClass: and #fullHierarchyOnClass:selector:. =============== Diff against Tools-mt.1196 =============== Item was added: + ----- Method: Browser class>>fullHierarchyOnClass: (in category 'instance creation') ----- + fullHierarchyOnClass: aClass + + ^ HierarchyBrowser fullOnClass: aClass! Item was added: + ----- Method: Browser class>>fullHierarchyOnClass:selector: (in category 'instance creation') ----- + fullHierarchyOnClass: aClass selector: aSelector + + ^ HierarchyBrowser fullOnClass: aClass selector: aSelector! Item was changed: ----- Method: Model>>addItem: (in category '*Tools') ----- addItem: classAndMethod "Open a browser directly on the given class and method Model new addItem: 'Model addItem:' Model new addItem: 'Model>>addItem:' " self flag: #mref. "classAndMethod is a String" MessageSet parse: classAndMethod toClassAndSelector: [ :class :sel | class ifNil: [^self]. sel = #Comment ifTrue: [^ SystemBrowser default fullOnClassComment: class]. sel = #Definition ifTrue: [^ SystemBrowser default newOnClass: class]. + sel = #Hierarchy ifTrue: [^ SystemBrowser default fullHierarchyOnClass: class]. - sel = #Hierarchy ifTrue: [^ HierarchyBrowser fullOnClass: class]. sel = #Help ifTrue: [^HelpBrowser openOn: class]. SystemBrowser default newOnClass: class selector: sel ] ! Item was changed: ----- Method: StandardToolSet class>>browseHierarchy:selector: (in category 'browsing') ----- browseHierarchy: aClass selector: aSelector + "Open a hierarchy browser" + + ^ SystemBrowser default fullHierarchyOnClass: aClass selector: aSelector! - "Open a browser" - - ^ HierarchyBrowser fullOnClass: aClass selector: aSelector.!

1 0

The Trunk: WebClient-Help-tpr.12.mcz
by commits＠source.squeak.org 10 Apr '23

10 Apr '23

tim Rowledge uploaded a new version of WebClient-Help to project The Trunk: http://source.squeak.org/trunk/WebClient-Help-tpr.12.mcz ==================== Summary ==================== Name: WebClient-Help-tpr.12 Author: tpr Time: 9 April 2023, 6:10:02.643749 pm UUID: 5e15f5b1-6367-4806-b2e2-28f065c2a24c Ancestors: WebClient-Help-kfr.11 Update the WebServer help info a little. It has, after all, been the case that the SqueakSSL package is built in since Squeak 5, so we don't need to tell people to load it. Also added info on the useful #logAction: capablilty =============== Diff against WebClient-Help-kfr.11 =============== Item was changed: ----- Method: WebServerHelp class>>authentication (in category 'pages') ----- authentication "This method was automatically generated. Edit it using:" "WebServerHelp edit: #authentication" + <generated> + ^(HelpTopic - ^HelpTopic title: 'Authentication' contents: 'To add authentication you can use web server as follows: + WebServer default addService: ''/smalltalk'' action: + [:req| | action | + WebServer default authenticate: req realm: ''squeak'' methods: #(digest basic) do: + [action := (req fields at: ''get'' ifAbsent:['''']) asSymbol. + req send200Response: (Smalltalk perform: action) asString]]. - WebServer default addService: ''/smalltalk'' action:[:req| | action | - WebServer default authenticate: req realm: ''squeak'' methods: #(digest basic) do:[ - action := (req fields at: ''get'' ifAbsent:['''']) asSymbol. - req send200Response: (Smalltalk perform: action) asString. - ]. - ]. The above supports both digest as well as basic authentication for accessing the /smalltalk service. Let''s add a user so that we can access it: WebServer default passwordAt: ''squeak'' realm: ''squeak'' put: ''squeak''. The server does NOT store plain text passwords, but rather hashes. To be precise, it stores the ha1 term used in digest authentication which is the same hash produced by htdigest. We can now access the /smalltalk service by providing user name ''squeak'' and password ''squeak''. (WebClient httpGet:''http://localhost:8080/smalltalk?get=platformName'') content. Unfortunately, digest authentication can be slow since our MD5 implementation is rather pathetic. !! + ]style[(69 7 1 11 1 12 1 10 2 3 1 1 1 1 6 1 1 13 7 1 13 1 3 1 6 1 8 1 8 3 6 1 5 2 7 1 6 1 2 1 1 3 1 6 1 3 1 5 1 9 1 2 1 1 1 8 5 3 1 16 1 1 10 8 1 6 1 1 8 1 160 7 1 11 1 8 1 6 1 8 1 4 1 8 292 8 50 2 7 102),c000000126,,c000000126,,c126000126,,c000000126,,c000000126,cgray;,,cgray;,,cgray;,,cgray;,,c000000126,,c000000126,,c000000126,,c000000126,,c126000126,,c000000126,,c000000126,,c000000126,,c000000126,c000126000,cgray;,,b,,c126000126,c000000126,,c000000126,,c000000126,,c126000126,,c000000126,c126000000,c126000126,c126000000,c126000126,,c000000126,,c000000126,,c000000126,,c126000126,,c000000126,,cgray;,c126000126,,c000000126,c000126000,,c000000126,,c000000126,,c126000126,,c000000126,,c126000126,,c000000126,,c126000126,,c000000126,c126000126,,c000000126,!!' readStream nextChunkText) + key: #authentication; + shouldStyle: false; + yourself! - ]style[(58 11 7 1 11 1 12 1 7 2 3 1 1 1 1 6 1 1 13 7 1 13 1 3 1 6 1 8 1 8 3 6 1 5 2 3 1 4 6 1 2 1 1 3 1 6 1 3 1 5 1 9 1 2 1 1 1 8 5 3 1 16 1 1 10 8 1 6 1 1 8 4 1 6 146 11 7 1 11 1 8 1 6 1 8 1 4 1 8 2 278 12 8 50 2 7 2 100),cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,cblack;,c000000127,cgray;,cblack;,cgray;,cblack;,cgray;,cblack;,cgray;,cblack;,c000000127,cblack;,c000000127,cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,cblack;,c000000127,cblack;,c000000127,cblack;,c000000127,c000127000,cblack;,cgray;,cblack;,b,cblack;,c127000127,c000000127,cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,c127000000,c127000127,c127000000,c127000127,cblack;,c000000127,cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,cblack;,cgray;,c127000127,cblack;,c000000127,cblack;,c000127000,cblack;,,cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,cblack;,c127000127,cblack ;,c000000127,cblack;,c127000127,cblack;,,cblack;,c000000127,c127000127,cblack;,c000000127,cblack;,!!' readStream nextChunkText! Item was changed: ----- Method: WebServerHelp class>>logging (in category 'pages') ----- logging "This method was automatically generated. Edit it using:" "WebServerHelp edit: #logging" + <generated> + ^(HelpTopic - ^HelpTopic title: 'Logging' contents: + 'WebServer supports request logging in common log format. In order to tell WebServer where to log to you can either give it a stream: - 'WebServer supports logging in common log format. In order to tell WebServer where to log to you can either give it a stream: WebServer default accessLog: Transcript. or alternatively a file name, for example: WebServer default accessLog: ''/var/log/wsd/access_log''. When used in the latter form, WebServer opens and closes the file for each log entry which provides additional robustness at the cost of some performance. + + WebServer also logs status info and error reports. The #log: method uses the logAction instVar - a block or message send - to display or otherwise save the info. The default logAction (WebServer>>#initialize) is simply to pass the info to the Transcript, but more sophisticated usage might include sending it to the ToothPick logger package or via an MQTT connection. !! + ]style[(145 7 1 10 69 7 1 10 1 25 527),c000000125,,c000000125,,c000000125,,c000000125,,c125000125,!!' readStream nextChunkText) + key: #logging; + shouldStyle: false; + yourself! - ]style[(126 11 7 1 10 12 46 11 7 1 10 1 25 1 157),cblack;,c000000127,cblack;,c000000127,cblack;,,cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,!!' readStream nextChunkText! Item was changed: ----- Method: WebServerHelp class>>sslSupport (in category 'pages') ----- sslSupport "This method was automatically generated. Edit it using:" "WebServerHelp edit: #sslSupport" + <generated> + ^(HelpTopic - ^HelpTopic title: 'SSL/TLS Support' contents: + 'WebServer supports secure connections over SSL/TLS via SqueakSSL. With SqueakSSL installed, you can tell WebServer to use a particular cert which puts WebServer into secure mode. - 'WebServer supports secure connections over SSL/TLS via SqueakSSL. To install SqueakSSL, execute the following: - (Installer ss project: ''SqueakSSL'') - install: ''SqueakSSL-Core''; - install: ''SqueakSSL-Tests''. - - If you have SqueakSSL installed, you can tell WebServer to use a particular cert which puts WebServer into secure mode. - The certName itself is platform dependent. On Unix, the cert name is the path to the .pem file with BOTH the cert and the private key, for example: WebServer default certName: ''/home/user/certs/testcert.pem''. On Windows, the cert name is a string that is matched against the certificate subject. Usually, the certificate subject includes your host name so that you would use: WebServer default certName: ''secure.domain.com''. Client certificate handling is currently not supported. !! + ]style[(340 7 1 9 1 31 182 7 1 9 1 19 59),c000000124,,c000000124,,c124000124,,c000000124,,c000000124,,c124000124,!!' readStream nextChunkText) + key: #sslSupport; + shouldStyle: false; + yourself! - ]style[(112 12 2 1 8 1 11 4 8 1 16 4 8 1 17 1 272 11 7 1 9 1 31 1 170 11 7 1 9 1 19 1 58),cblack;,c000000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,cblack;,c127000127,cblack;,c000000127,cblack;,c127000127,cblack;,,cblack;,c000000125,cblack;,c000000125,cblack;,c125000125,cblack;,,cblack;,c000000125,cblack;,c000000125,cblack;,c125000125,cblack;,!!' readStream nextChunkText!

1 0

The Trunk: System-tpr.1411.mcz
by commits＠source.squeak.org 08 Apr '23

08 Apr '23

tim Rowledge uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tpr.1411.mcz ==================== Summary ==================== Name: System-tpr.1411 Author: tpr Time: 8 April 2023, 12:40:44.232921 pm UUID: ce793344-787e-4e47-9823-c49991f1e8c2 Ancestors: System-eem.1410 Bring in Stephane Rollandin's fix for SmartRefStream loading; it solves the .morph loading issue raised by https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou… =============== Diff against System-eem.1410 =============== Item was changed: ----- Method: SmartRefStream>>next (in category 'read write') ----- next "Really write three objects: (version, class structure, object). But only when called from the outside. " | version ss object | ^ topCall == nil ifTrue: [topCall := #marked. version := super next. version class == SmallInteger ifFalse: [^ version]. "version number, else just a regular object, not in our format, " self checkCrLf. ss := super next. ss class == Array ifFalse: [^ ss]. "just a regular object" (ss at: 1) = 'class structure' ifFalse: [^ ss]. + structures := (ss at: 2) rehash. - structures := ss at: 2. superclasses := (ss size > 3 and: [(ss at: 3) = 'superclasses']) + ifTrue: [(ss at: 4) rehash] "class name -> superclass name" - ifTrue: [ss at: 4] "class name -> superclass name" ifFalse: [Dictionary new]. (self verifyStructure = 'conversion method needed') ifTrue: [^ nil]. + object := super next rehash. "all the action here" - object := super next. "all the action here" self restoreClassInstVars. "for UniClasses. version 4" topCall := nil. "reset it" object] ifFalse: + [super next rehash] - [super next] !

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages April 2023