Packages April 2023

packages@lists.squeakfoundation.org

1 participants
37 discussions

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

17 Apr '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1200.mcz ==================== Summary ==================== Name: Tools-mt.1200 Author: mt Time: 17 April 2023, 11:37:04.576908 am UUID: 8844637f-3bde-a64e-92d2-c61d61cf42dd Ancestors: Tools-mt.1199 In tree browsers, fixes issue where a new hierarchy browser did always open whenever users create a new class. =============== Diff against Tools-mt.1199 =============== Item was changed: ----- Method: TreeBrowser>>spawnOrNavigateTo: (in category 'extras - hierarchy browser') ----- spawnOrNavigateTo: aClass + (self isHierarchy not or: [aClass inheritsFrom: classForHierarchy]) - (aClass inheritsFrom: classForHierarchy) ifTrue: [ super spawnOrNavigateTo: aClass ] ifFalse: [ self systemNavigation browseHierarchy: aClass ].!

1 0

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

17 Apr '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1199.mcz ==================== Summary ==================== Name: Tools-mt.1199 Author: mt Time: 17 April 2023, 11:26:34.910908 am UUID: 5af9f4ac-26cf-6f49-9204-50e1326226cf Ancestors: Tools-mt.1198 Complement Morphic-mt.2105 =============== Diff against Tools-mt.1198 =============== Item was changed: ----- Method: TreeBrowser>>buildClassListWith: (in category 'toolbuilder') ----- buildClassListWith: builder | tree | tree := builder pluggableTreeSpec new. tree model: self; roots: #classRoots; label: #classLabel:; getChildren: #classChildren:; hasChildren: #classHasChildren:; + autoExpand: #classTreeExpanded; 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>>classTreeExpanded (in category 'class tree') ----- + classTreeExpanded + + ^ self selectedSystemCategory ~= SystemOrganizer allCategory ! Item was changed: ----- 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:]]" - ifFalse: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]] ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}].! Item was changed: ----- Method: TreeBrowser>>updateClassTree: (in category 'updating') ----- updateClassTree: newList lastClassList := newList. + self changed: #classTreeExpanded. self changed: #classRoots. self expandClassTree. self changed: #classChild.!

1 0

The Trunk: Morphic-mt.2106.mcz
by commits＠source.squeak.org 17 Apr '23

17 Apr '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2106.mcz ==================== Summary ==================== Name: Morphic-mt.2106 Author: mt Time: 17 April 2023, 11:24:23.650908 am UUID: d1b62823-ca2e-1b42-a323-c27a00055324 Ancestors: Morphic-mt.2105 Complement Morphic-mt.2105 =============== Diff against Morphic-mt.2105 =============== Item was changed: ----- Method: SimpleHierarchicalListMorph>>autoExpandSelector: (in category 'accessing') ----- autoExpandSelector: aSymbol + autoExpandSelector := aSymbol. + self updateAutoExpand.! - autoExpandSelector := aSymbol.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>updateAutoExpand (in category 'updating') ----- updateAutoExpand + self autoExpand: (model perform: (autoExpandSelector ifNil: [^ self])).! - self autoExpand: (model perform: autoExpandSelector).!

1 0

The Trunk: ToolBuilder-Morphic-mt.337.mcz
by commits＠source.squeak.org 17 Apr '23

17 Apr '23

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.337.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.337 Author: mt Time: 17 April 2023, 11:22:54.720908 am UUID: 2ca79462-b98a-084c-b553-a04703eec8e1 Ancestors: ToolBuilder-Morphic-mt.336 Complement Morphic-mt.2105 =============== Diff against ToolBuilder-Morphic-mt.336 =============== Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'widgets required') ----- buildPluggableTree: aSpec | widget | widget := self treeClass new. self register: widget id: aSpec name. widget getLabelSelector: aSpec label. widget getIconSelector: aSpec icon. widget model: aSpec model. widget nodeClass: aSpec nodeClass. widget getRootsSelector: aSpec roots. widget getChildrenSelector: aSpec getChildren. widget hasChildrenSelector: aSpec hasChildren. + + aSpec autoExpand isSymbol + ifTrue: [widget autoExpandSelector: aSpec autoExpand] + ifFalse: [widget autoExpand: aSpec autoExpand]. + widget autoExpand ifTrue: [widget update: aSpec roots]. widget filterMode: aSpec filterMode. widget searchMode: aSpec searchMode. widget getSelectedPathSelector: aSpec getSelectedPath. widget setSelectedPathSelector: aSpec setSelectedPath. widget getSelectedSelector: aSpec getSelected. widget setSelectedSelector: aSpec setSelected. widget setSelectedParentSelector: aSpec setSelectedParent. widget getHelpSelector: aSpec help. widget getMenuSelector: aSpec menu. widget keystrokeActionSelector: aSpec keyPress. widget autoDeselect: aSpec autoDeselect. widget doubleClickSelector: aSpec doubleClick. widget dropItemSelector: aSpec dropItem. widget wantsDropSelector: aSpec dropAccept. widget dragItemSelector: aSpec dragItem. widget dragStartedSelector: aSpec dragStarted. widget dragTypeSelector: aSpec dragType. widget columns: aSpec columns. "Override default scroll bar policies if needed. Widget will use preference values otherwise." aSpec hScrollBarPolicy ifNotNil: [:policy | policy caseOf: { [#always] -> [widget alwaysShowHScrollBar]. [#never] -> [widget hideHScrollBarIndefinitely]. [#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ]. aSpec vScrollBarPolicy ifNotNil: [:policy | policy caseOf: { [#always] -> [widget alwaysShowVScrollBar]. [#never] -> [widget hideVScrollBarIndefinitely]. [#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ]. self setFrame: aSpec frame in: widget. self setLayoutHintsFor: widget spec: aSpec. parent ifNotNil:[self add: widget to: parent]. " panes ifNotNil:[ aSpec roots ifNotNil:[panes add: aSpec roots]. ]. " ^widget!

1 0

The Trunk: ToolBuilder-Kernel-mt.165.mcz
by commits＠source.squeak.org 17 Apr '23

17 Apr '23

Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.165.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-mt.165 Author: mt Time: 17 April 2023, 11:10:55.175908 am UUID: a6da9de1-d469-cf49-b77d-4e74dea156e6 Ancestors: ToolBuilder-Kernel-mt.164 Complement Morphic-mt.2105 =============== Diff against ToolBuilder-Kernel-mt.164 =============== Item was changed: PluggableWidgetSpec subclass: #PluggableTreeSpec + instanceVariableNames: 'roots getSelectedPath setSelectedPath setSelected getSelected setSelectedParent getChildren hasChildren label icon unusedVar menu keyPress doubleClick dropItem dropAccept autoDeselect autoExpand dragItem dragType nodeClass columns vScrollBarPolicy hScrollBarPolicy dragStarted filterMode searchMode' - instanceVariableNames: 'roots getSelectedPath setSelectedPath setSelected getSelected setSelectedParent getChildren hasChildren label icon unusedVar menu keyPress doubleClick dropItem dropAccept autoDeselect dragItem dragType nodeClass columns vScrollBarPolicy hScrollBarPolicy dragStarted filterMode searchMode' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableTreeSpec commentStamp: 'pre 4/24/2018 10:20' prior: 0! A pluggable tree widget. PluggableTrees are slightly different from lists in such that they ALWAYS store the actual objects and use the label selector to query for the label of the item. PluggableTrees also behave somewhat differently in such that they do not have a "getSelected" message but only a getSelectedPath message. The difference is that getSelectedPath is used to indicate by the model that the tree should select the appropriate path. This allows disambiguation of items. Because of this, implementations of PluggableTrees must always set their internal selection directly, e.g., rather than sending the model a setSelected message and wait for an update of the #getSelected the implementation must set the selection before sending the #setSelected message. If a client doesn't want this, it can always just signal a change of getSelectedPath to revert to whatever is needed. Instance variables: roots <Symbol> The message to retrieve the roots of the tree. getSelectedPath <Symbol> The message to retrieve the selected path in the tree. setSelectedPath <Symbol> The message to set the selected path in the tree. setSelected <Symbol> The message to set the selected item in the tree. getChildren <Symbol> The message to retrieve the children of an item hasChildren <Symbol> The message to query for children of an item label <Symbol> The message to query for the label of an item. icon <Symbol> The message to query for the icon of an item. help <Symbol> The message to query for the help of an item. menu <Symbol> The message to query for the tree's menu keyPress <Symbol> The message to process a keystroke. wantsDrop <Symbol> The message to query whether a drop might be accepted. dropItem <Symbol> The message to drop an item. enableDrag <Boolean> Enable dragging from this tree. autoDeselect <Boolean> Whether the tree should allow automatic deselection or not. unusedVar (unused) This variable is a placeholder to fix problems with loading packages in 3.10.! Item was added: + ----- Method: PluggableTreeSpec>>autoExpand (in category 'accessing - hierarchy') ----- + autoExpand + "If true, all children are always visible." + + ^ autoExpand ifNil: [false]! Item was added: + ----- Method: PluggableTreeSpec>>autoExpand: (in category 'accessing - hierarchy') ----- + autoExpand: aBooleanOrSymbol + + autoExpand := aBooleanOrSymbol.!

1 0

The Trunk: Morphic-mt.2105.mcz
by commits＠source.squeak.org 17 Apr '23

17 Apr '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2105.mcz ==================== Summary ==================== Name: Morphic-mt.2105 Author: mt Time: 17 April 2023, 11:10:21.029908 am UUID: 78d49dc0-9675-804f-85c7-fe3b06d397a2 Ancestors: Morphic-mt.2104 Adds #autoExpand feature to tree widgets where toggle-buttons are hidden, root-indent is 0, and the entire hierarchy is visible all the time. Only works for finite tree structures. Use #autoExpand to improve user experience through minimized input. =============== Diff against Morphic-mt.2104 =============== Item was changed: ----- Method: IndentingListItemMorph>>drawLineToggleToTextOn:lineColor:hasToggle: (in category 'drawing') ----- drawLineToggleToTextOn: aCanvas lineColor: lineColor hasToggle: hasToggle "If I am not the only item in my container, draw the line between: - my toggle (if any) or my left edge (if no toggle) - and my text left edge" | myBounds myCenter hLineY hLineLeft | self isSoleItem ifTrue: [ ^self ]. + (self canExpand and: [container autoExpand == false]) ifTrue: [ ^self ]. - self canExpand ifTrue: [ ^self ]. myBounds := self toggleBounds. myCenter := myBounds center. hLineY := myCenter y. hLineLeft := myCenter x. "Draw line from toggle to text" aCanvas line: hLineLeft @ hLineY to: myBounds right @ hLineY width: 1 px color: lineColor! Item was changed: ----- Method: IndentingListItemMorph>>drawToggleOn:in: (in category 'drawing') ----- drawToggleOn: aCanvas in: aRectangle | aForm centeringOffset | self canExpand ifFalse: [^self]. + container autoExpand == true ifTrue: [^ self]. aForm := isExpanded ifTrue: [container expandedForm] ifFalse: [container notExpandedForm]. centeringOffset := (aRectangle extent - aForm extent) // 2. isExpanded ifFalse: [centeringOffset := centeringOffset + (1 px @ 0)]. ^aCanvas paintImage: aForm at: aRectangle topLeft + centeringOffset. ! Item was changed: ----- Method: IndentingListItemMorph>>toggleRectangle (in category 'private') ----- toggleRectangle + | h indent offset | - | h indent | h := bounds height. indent := 12 px. + offset := container autoExpand == true ifTrue: [-1] ifFalse: [0]. + ^(bounds left + self hMargin + (indent * (indentLevel+offset))) @ bounds top extent: indent@h! - ^(bounds left + self hMargin + (indent * indentLevel)) @ bounds top extent: indent@h! Item was changed: ScrollPane subclass: #SimpleHierarchicalListMorph + instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect autoExpand autoExpandSelector columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor font textColor' - instanceVariableNames: 'selectedMorph hoveredMorph getListSelector keystrokeActionSelector autoDeselect columns columnsCache sortingSelector getSelectionSelector setSelectionSelector potentialDropMorph lineColor font textColor' classVariableNames: 'ExpandAllLimit ExpandedForm NotExpandedForm WrappedNavigation' poolDictionaries: '' category: 'Morphic-Explorer'! !SimpleHierarchicalListMorph commentStamp: 'ls 3/1/2004 12:15' prior: 0! Display a hierarchical list of items. Each item should be wrapped with a ListItemWrapper. For a simple example, look at submorphsExample. For beefier examples, look at ObjectExplorer or FileList2.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>arrowKey: (in category 'keyboard navigation') ----- arrowKey: asciiValue "Handle a keyboard navigation character. Answer true if handled, false if not." | keyEvent min max oldSelection nextSelection howManyItemsShowing keyHandled | keyHandled := false. keyEvent := asciiValue. max := self maximumSelection. min := self minimumSelection. nextSelection := oldSelection := self getSelectionIndex. keyEvent = 31 ifTrue:["down" self currentEvent shiftPressed ifTrue: [ self selectedMorph nextVisibleSibling ifNil: ["TODO: wrappedNavigation" ^ true] ifNotNil: [:m | self setSelectedMorph: m. ^ true]]. keyHandled := true. nextSelection :=oldSelection + 1. nextSelection > max ifTrue: [nextSelection := (self class wrappedNavigation ifTrue: [min] ifFalse: [^ true])]]. keyEvent = 30 ifTrue:["up" self currentEvent shiftPressed ifTrue: [ self selectedMorph previousVisibleSibling ifNil: ["TODO: wrappedNaviagtion" ^ true] ifNotNil: [:m | self setSelectedMorph: m. ^ true]]. keyHandled := true. nextSelection := oldSelection - 1. nextSelection < min ifTrue: [nextSelection := self class wrappedNavigation ifTrue: [max] ifFalse: [^ true]]]. keyEvent = 1 ifTrue: ["home" keyHandled := true. nextSelection := min]. keyEvent = 4 ifTrue: ["end" keyHandled := true. nextSelection := max]. howManyItemsShowing := self numSelectionsInView. keyEvent = 11 ifTrue: ["page up" keyHandled := true. nextSelection := min max: oldSelection - howManyItemsShowing]. keyEvent = 12 ifTrue: ["page down" keyHandled := true. nextSelection := oldSelection + howManyItemsShowing min: max]. (nextSelection ~= oldSelection or: [ keyHandled and: [ self class wrappedNavigation not ]]) ifTrue: [ self setSelectionIndex: nextSelection. ^ true]. keyEvent = 29 ifTrue:["right" + autoExpand == true ifTrue: [^ true]. selectedMorph ifNotNil:[ (selectedMorph canExpand and:[selectedMorph isExpanded not]) ifTrue:[self currentEvent shiftPressed ifTrue: [self expandAllSafely: selectedMorph] ifFalse: [self toggleExpandedState: selectedMorph]] ifFalse:[self setSelectionIndex: self getSelectionIndex+1]. ]. ^true]. keyEvent = 28 ifTrue:["left" + autoExpand == true ifTrue: [^ true]. selectedMorph ifNotNil:[ (selectedMorph isExpanded) ifTrue:[self toggleExpandedState: selectedMorph] ifFalse:[ self selectedParentMorph ifNil: [self setSelectionIndex: (self getSelectionIndex-1 max: 1)] ifNotNil: [:pm | self setSelectedMorph: pm]] ]. ^true]. ^false! Item was added: + ----- Method: SimpleHierarchicalListMorph>>autoExpand (in category 'accessing') ----- + autoExpand + + ^ autoExpand == true! Item was added: + ----- Method: SimpleHierarchicalListMorph>>autoExpand: (in category 'accessing') ----- + autoExpand: aBoolean + + autoExpand := aBoolean.! Item was added: + ----- Method: SimpleHierarchicalListMorph>>autoExpandSelector (in category 'accessing') ----- + autoExpandSelector + + ^ autoExpandSelector! Item was added: + ----- Method: SimpleHierarchicalListMorph>>autoExpandSelector: (in category 'accessing') ----- + autoExpandSelector: aSymbol + + autoExpandSelector := aSymbol.! Item was added: + ----- Method: SimpleHierarchicalListMorph>>expandAllRoots (in category 'events') ----- + expandAllRoots + "Expand all, starting with the receiver's roots. Unlike #expandAll, which starts with the current selection." + + self roots do: [:ea | self expandAll: ea]. + self adjustSubmorphPositions.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>list: (in category 'initialization') ----- list: aCollection | wereExpanded morphList | + wereExpanded := autoExpand == true + ifTrue: [#()] + ifFalse: [self currentlyExpanded]. - wereExpanded := self currentlyExpanded. scroller removeAllMorphs. (aCollection isNil or: [aCollection isEmpty]) ifTrue: [^ self selectedMorph: nil]. morphList := OrderedCollection new. self addMorphsTo: morphList from: aCollection allowSorting: false withExpandedItems: wereExpanded atLevel: 0. + self insertNewMorphs: morphList. + autoExpand == true ifTrue: [self expandAllRoots].! - self insertNewMorphs: morphList.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>toggleExpandedState:event: (in category 'events') ----- toggleExpandedState: aMorph event: aMouseEvent "Mouse navigation. Thus, avoid changing scroll position. See #toggleExpandedState: for keyboard navigation." + autoExpand == true ifTrue: [^ self]. aMorph toggleExpandedState. self adjustSubmorphPositions. ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>update: (in category 'updating') ----- update: aSymbol aSymbol == getSelectionSelector ifTrue: [self updateSelection. ^self]. aSymbol == getListSelector ifTrue: [self list: self getList. ^self]. + aSymbol == autoExpandSelector + ifTrue: + [self updateAutoExpand. + ^self]. ((aSymbol isKindOf: Array) and: [aSymbol notEmpty and: [aSymbol first == #openPath]]) ifTrue: [^(scroller submorphs at: 1 ifAbsent: [^self]) openPath: aSymbol allButFirst]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>updateAutoExpand (in category 'updating') ----- + updateAutoExpand + + self autoExpand: (model perform: autoExpandSelector).!

1 0

The Trunk: Morphic-mt.2104.mcz
by commits＠source.squeak.org 17 Apr '23

17 Apr '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2104.mcz ==================== Summary ==================== Name: Morphic-mt.2104 Author: mt Time: 17 April 2023, 10:03:09.882908 am UUID: 80b5342f-b2a5-df42-b408-edf46ec97c41 Ancestors: Morphic-mt.2103 When removing list filters, keep screen contents (i.e., text) stable by adjusting scroll position. Just like in tree widgets. =============== Diff against Morphic-mt.2103 =============== Item was added: + ----- Method: PluggableListMorph>>fixateSelectionDuring: (in category 'selection') ----- + fixateSelectionDuring: aBlock + + | vDelta sRow sRect | + (sRow := self listMorph selectedRow) ifNil: [aBlock value. ^ self]. + + sRect := self listMorph drawBoundsForRow: sRow. + vDelta := ((listMorph localPointToGlobal: sRect topLeft) + - (scroller localPointToGlobal: scroller topLeft)) y. + + aBlock value. + + (sRow := self listMorph selectedRow) ifNotNil: [ + sRect := self listMorph drawBoundsForRow: sRow. + self scrollToBottom. + self scrollToShow: (sRect outsetBy: (0@vDelta corner: 0@0))].! Item was changed: ----- Method: PluggableListMorph>>keyboardFocusChange: (in category 'event handling') ----- keyboardFocusChange: aBoolean "Clear the hover effect and maybe the current list filter if we lose keyboard focus." aBoolean ifFalse: [self hoverRow: nil. self clearFilterAutomatically ifTrue: + [self fixateSelectionDuring: [self removeFilter]]]. - [self removeFilter]]. super keyboardFocusChange: aBoolean.! Item was changed: ----- Method: PluggableListMorph>>specialKeyPressed: (in category 'model access - keystroke') ----- specialKeyPressed: asciiValue "A special key with the given ascii-value was pressed; dispatch it" | oldSelection nextSelection max howManyItemsShowing | (#(8 13) includes: asciiValue) ifTrue: + [ "complete type-in filter by clearing it; backspace key: restore prior selection; return key: keep selection" - [ "backspace key - clear the filter, restore the list with the selection" model okToChange ifFalse: [^ self]. + self fixateSelectionDuring: [self removeFilter]. - self removeFilter. priorSelection ifNotNil: [ | prior | prior := priorSelection. priorSelection := self getCurrentSelectionIndex. asciiValue = 8 ifTrue: [ self changeModelSelection: prior ] ]. ^ self ]. asciiValue = 27 ifTrue: [" escape key" ^ self currentEvent shiftPressed ifTrue: [self currentWorld putUpWorldMenuFromEscapeKey] ifFalse: [self yellowButtonActivity: false]]. max := self maximumSelection. max > 0 ifFalse: [^ self]. nextSelection := oldSelection := self selectionIndex. asciiValue = 31 ifTrue: [" down arrow" nextSelection := oldSelection + 1. nextSelection > max ifTrue: [nextSelection := 1]]. asciiValue = 30 ifTrue: [" up arrow" nextSelection := oldSelection - 1. nextSelection < 1 ifTrue: [nextSelection := max]]. asciiValue = 1 ifTrue: [" home" nextSelection := 1]. asciiValue = 4 ifTrue: [" end" nextSelection := max]. howManyItemsShowing := self numSelectionsInView. asciiValue = 11 ifTrue: [" page up" nextSelection := 1 max: oldSelection - howManyItemsShowing]. asciiValue = 12 ifTrue: [" page down" nextSelection := oldSelection + howManyItemsShowing min: max]. model okToChange ifFalse: [^ self]. "No change if model is locked" oldSelection = nextSelection ifTrue: [^ self flash]. ^ self changeModelSelection: (self modelIndexFor: nextSelection)!

1 0

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

14 Apr '23

tim Rowledge uploaded a new version of WebClient-Help to project The Trunk: http://source.squeak.org/trunk/WebClient-Help-tpr.13.mcz ==================== Summary ==================== Name: WebClient-Help-tpr.13 Author: tpr Time: 13 April 2023, 5:54:32.79161 pm UUID: cbfe4541-f368-4d74-b157-d0b75d121a52 Ancestors: WebClient-Help-tpr.12 The WebServer/Client implementation of digest authentication via MD5 is no longer pathetic, so remove the complaint from the Help page =============== Diff against WebClient-Help-tpr.12 =============== Item was changed: ----- Method: WebServerHelp class>>authentication (in category 'pages') ----- authentication "This method was automatically generated. Edit it using:" "WebServerHelp edit: #authentication" <generated> ^(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]]. 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 3),c000000125,,c000000125,,c125000125,,c000000125,,c000000125,cgray;,,cgray;,,cgray;,,cgray;,,c000000125,,c000000125,,c000000125,,c000000125,,c125000125,,c000000125,,c000000125,,c000000125,,c000000125,c000125000,cgray;,,b,,c125000125,c000000125,,c000000125,,c000000125,,c125000125,,c000000125,c125000000,c125000125,c125000000,c125000125,,c000000125,,c000000125,,c000000125,,c125000125,,c000000125,,cgray;,c125000125,,c000000125,c000125000,,c000000125,,c000000125,,c125000125,,c000000125,,c125000125,,c000000125,,c125000125,,c000000125,c125000125,,c000000125,!!' readStream nextChunkText) - ]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!

1 0

The Trunk: WebClient-Core-ul.132.mcz
by commits＠source.squeak.org 14 Apr '23

14 Apr '23

tim Rowledge uploaded a new version of WebClient-Core to project The Trunk: http://source.squeak.org/trunk/WebClient-Core-ul.132.mcz ==================== Summary ==================== Name: WebClient-Core-ul.132 Author: ul Time: 11 April 2023, 6:05:30.414442 pm UUID: 7d14b070-76e7-47d2-a31d-9a2b283cefc6 Ancestors: WebClient-Core-mt.130 Speed up MD5 computation in WebUtils: - deprecated #md5HashStream: in favor of #md5HashStreamAsBytes:, which does the same, but returns the bytes in the correct order (not reversed). - avoid reading and writing words from and to ByteArrays (buffer) by changing the class of buffer between WordArray and ByteArray as needed. Hopefully endianness will be fine on all platforms (tests will fail if not). - 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 ~6x 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 md5Digest: 'foo' " - This is the same as htdigest (apache) uses for its md5 digest auth db" + ^(self md5HashStreamAsBytes: aStringOrByteArray readStream) hex! - ^(self md5HashStream: (ReadStream on: aStringOrByteArray asByteArray)) reversed hex! Item was changed: ----- Method: WebUtils class>>md5HashStream: (in category 'md5') ----- md5HashStream: aStream + "This method returns the bytes of the md5 hash in revese order for backwards compatibility. Consider updating your implementation to avoid unnecessary reversal. - "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 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. + self md5HashStream: 'foo' readStream " + + self deprecated: 'Use #md5HashStreamAsBytes: and reverse the bytes in your code.'. + ^(self md5HashStreamAsBytes: aStream) reverseInPlace! - ^(ByteArray new: 16) - 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 added: + ----- Method: WebUtils class>>md5HashStreamAsBytes: (in category 'md5') ----- + md5HashStreamAsBytes: aStream + "Return a ByteArray containing the md5 hash of aStream. + + self md5HashStreamAsBytes: 'foo' readStream " + + | start buffer chunkSize n hash | + hash := WordArray + with: 16r67452301 + with: 16rEFCDAB89 + with: 16r98BADCFE + with: 16r10325476. + buffer := ByteArray new: 64. + start := aStream position. + [ + chunkSize := aStream readInto: buffer startingAt: 1 count: 64. + chunkSize < 64 or: [ aStream atEnd ] ] + whileFalse: [ + WordArray adoptInstance: buffer. + self md5Transform: buffer hash: hash. + ByteArray adoptInstance: buffer ]. + 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]. + WordArray adoptInstance: buffer. + self md5Transform: buffer hash: hash. + ByteArray adoptInstance: buffer. + "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" + WordArray adoptInstance: buffer. + self md5Transform: buffer hash: hash. + ByteArray adoptInstance: hash. "Trick to avoid reallocation." + ^hash! 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 md5HashStreamAsBytes: bytes readStream! - ^(self md5HashStream: bytes readStream) reversed!

1 0

The Trunk: WebClient-Core-ul.132.mcz
by commits＠source.squeak.org 14 Apr '23

14 Apr '23

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