Squeak-dev April 2017

squeak-dev@lists.squeakfoundation.org

48 participants
221 discussions

The Trunk: Kernel-nice.1101.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1101.mcz ==================== Summary ==================== Name: Kernel-nice.1101 Author: nice Time: 26 April 2017, 11:32:58.822457 pm UUID: e7668d92-95a7-4ece-967a-35a6bf61c946 Ancestors: Kernel-eem.1100 Fix the dividend of ZeroDivide exception in case of reciprocal. Classify a few 'as yet unclassified' methods. =============== Diff against Kernel-eem.1100 =============== Item was changed: + ----- Method: ClassCommentReader>>scanFrom: (in category 'filein/Out') ----- - ----- Method: ClassCommentReader>>scanFrom: (in category 'as yet unclassified') ----- scanFrom: aStream "File in the class comment from aStream. Not string-i-fied, just a text, exactly as it is in the browser. Move to changes file." class theNonMetaClass classComment: (aStream nextChunkText) stamp: changeStamp "Writes it on the disk and saves a RemoteString ref"! Item was changed: + ----- Method: ClassCommentReader>>scanFrom:environment: (in category 'filein/Out') ----- - ----- Method: ClassCommentReader>>scanFrom:environment: (in category 'as yet unclassified') ----- scanFrom: aStream environment: anEnvironment ^ self scanFrom: aStream! Item was changed: + ----- Method: ClassCommentReader>>scanFromNoCompile: (in category 'filein/Out') ----- - ----- Method: ClassCommentReader>>scanFromNoCompile: (in category 'as yet unclassified') ----- scanFromNoCompile: aStream "File in the class comment from aStream. Not string-i-fied, just a text, exactly as it is in the browser. Move to changes file." self scanFrom: aStream. "for comments, the same as usual"! Item was changed: ----- Method: Complex>>reciprocal (in category 'arithmetic') ----- reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." self = 0 + ifTrue: [^ (ZeroDivide dividend: 1) signal] - ifTrue: [^ (ZeroDivide dividend: self) signal] ifFalse: [^1 / self] ! Item was changed: + ----- Method: Error>>defaultAction (in category 'handling') ----- - ----- Method: Error>>defaultAction (in category 'exceptionDescription') ----- defaultAction "No one has handled this error, but now give them a chance to decide how to debug it. If none handle this either then open debugger (see UnhandedError-defaultAction)" UnhandledError signalForException: self! Item was changed: ----- Method: Number>>raisedTo: (in category 'mathematical functions') ----- raisedTo: aNumber "Answer the receiver raised to aNumber." aNumber isInteger ifTrue: [ "Do the special case of integer power" ^ self raisedToInteger: aNumber]. aNumber isFraction ifTrue: [ "Special case for fraction power" ^ (self nthRoot: aNumber denominator) raisedToInteger: aNumber numerator ]. self negative ifTrue: [ ^ ArithmeticError signal: 'Negative numbers can''t be raised to float powers.' ]. aNumber isZero ifTrue: [^ self class one]. "Special case of exponent=0" 1 = aNumber ifTrue: [^ self]. "Special case of exponent=1" self isZero ifTrue: [ "Special case of self = 0" aNumber negative + ifTrue: [^ (ZeroDivide dividend: 1) signal] - ifTrue: [^ (ZeroDivide dividend: self) signal] ifFalse: [^ self]]. ^ (aNumber * self ln) exp "Otherwise use logarithms"!

1 0

The Trunk: MorphicTests-nice.40.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-nice.40.mcz ==================== Summary ==================== Name: MorphicTests-nice.40 Author: nice Time: 26 April 2017, 11:18:11.635198 pm UUID: e709833d-000f-471c-abed-23c75c36b9ad Ancestors: MorphicTests-mt.39 Classify a few 'as yet unclassified' methods =============== Diff against MorphicTests-mt.39 =============== Item was changed: + ----- Method: CircleMorphBugs>>testCircleInstance (in category 'tests') ----- - ----- Method: CircleMorphBugs>>testCircleInstance (in category 'as yet unclassified') ----- testCircleInstance "" "self run: #testCircleInstance" | circ | self assert: (circ := CircleMorph initializedInstance) extent = circ extent x asPoint ! Item was changed: + ----- Method: LayoutFrameTest>>testInset (in category 'tests') ----- - ----- Method: LayoutFrameTest>>testInset (in category 'as yet unclassified') ----- testInset | lf rectangle | lf := LayoutFrame new leftFraction: 0 offset: 10; topFraction: 0 offset: 10; rightFraction: 1 offset: -10; bottomFraction: 1 offset: -10; yourself. rectangle := lf layout: nil in: (50@10 corner: 150@70). self assert: (60@20 corner: 140@60) = rectangle! Item was changed: + ----- Method: LayoutFrameTest>>testLeftTopAligned (in category 'tests') ----- - ----- Method: LayoutFrameTest>>testLeftTopAligned (in category 'as yet unclassified') ----- testLeftTopAligned | lf rectangle | lf := LayoutFrame new leftFraction: 0 offset: 10; topFraction: 0 offset: 10; rightFraction: 0 offset: 60; bottomFraction: 0 offset: 25; yourself. rectangle := lf layout: nil in: (50@10 corner: 150@70). self assert: (60@20 corner: 110@35) = rectangle! Item was changed: + ----- Method: LayoutFrameTest>>testRightBottomQuadrant (in category 'tests') ----- - ----- Method: LayoutFrameTest>>testRightBottomQuadrant (in category 'as yet unclassified') ----- testRightBottomQuadrant | lf rectangle | lf := LayoutFrame new leftFraction: 1/2 offset: 1; topFraction: 1/2 offset: 1; rightFraction: 1 offset: -2; bottomFraction: 1 offset: -2; yourself. rectangle := lf layout: nil in: (50@10 corner: 150@70). self assert: (101@41 corner: 148@68) = rectangle! Item was changed: + ----- Method: LayoutFrameTest>>testSpaceFill (in category 'tests') ----- - ----- Method: LayoutFrameTest>>testSpaceFill (in category 'as yet unclassified') ----- testSpaceFill | lf rectangle | lf := LayoutFrame new leftFraction: 0 offset: 0; topFraction: 0 offset: 0; rightFraction: 1 offset: 0; bottomFraction: 1 offset: 0; yourself. rectangle := lf layout: nil in: (50@10 corner: 150@70). self assert: (50@10 corner: 150@70) = rectangle! Item was changed: + ----- Method: MorphicTestTextModel>>flags (in category 'accessing') ----- - ----- Method: MorphicTestTextModel>>flags (in category 'as yet unclassified') ----- flags ^ flags ifNil: [flags := Bag new]! Item was changed: + ----- Method: MorphicTestTextModel>>hasFlag: (in category 'accessing') ----- - ----- Method: MorphicTestTextModel>>hasFlag: (in category 'as yet unclassified') ----- hasFlag: aSymbol ^ self flags includes: aSymbol! Item was changed: + ----- Method: MorphicTestTextModel>>result (in category 'accessing') ----- - ----- Method: MorphicTestTextModel>>result (in category 'as yet unclassified') ----- result ^ result! Item was changed: + ----- Method: MorphicTestTextModel>>result: (in category 'accessing') ----- - ----- Method: MorphicTestTextModel>>result: (in category 'as yet unclassified') ----- result: anObject result := anObject.! Item was changed: + ----- Method: MorphicUIManagerTest>>defaultTimeout (in category 'accessing') ----- - ----- Method: MorphicUIManagerTest>>defaultTimeout (in category 'as yet unclassified') ----- defaultTimeout ^ 60 "seconds"! Item was changed: + ----- Method: MorphicUIManagerTest>>findWindowInWorldLabeled: (in category 'private') ----- - ----- Method: MorphicUIManagerTest>>findWindowInWorldLabeled: (in category 'as yet unclassified') ----- findWindowInWorldLabeled: aLabel "Look in the world and in the hand for windows. Yes, windows may spawn in the hand." ^ World submorphs, (World hands gather: [:hand | hand submorphs]) detect: [ :each | each isSystemWindow and: [ each label = aLabel ] ] ifNone: [].! Item was changed: + ----- Method: MorphicUIManagerTest>>setUp (in category 'initialize-release') ----- - ----- Method: MorphicUIManagerTest>>setUp (in category 'as yet unclassified') ----- setUp "default. tests will add morphs to list. Teardown will delete." cases := #(). uiManager := MorphicUIManager new.! Item was changed: + ----- Method: MorphicUIManagerTest>>tearDown (in category 'initialize-release') ----- - ----- Method: MorphicUIManagerTest>>tearDown (in category 'as yet unclassified') ----- tearDown "default. tests will add morphs to list. Teardown will delete." cases do: [ :each | each delete ].! Item was changed: + ----- Method: MorphicUIManagerTest>>testOpenWorkspace (in category 'tests') ----- - ----- Method: MorphicUIManagerTest>>testOpenWorkspace (in category 'as yet unclassified') ----- testOpenWorkspace "self new testOpenWorkspace" "MorphicUIBugTest run: #testOpenWorkspace" | window myLabel foundWindow myModel | myLabel := 'Workspace from SUnit test' . foundWindow := self findWindowInWorldLabeled: myLabel . self assert: foundWindow isNil. window := uiManager edit: '"MorphicUIBugTest run: #openWorkspaceTest"' label: myLabel. foundWindow := self findWindowInWorldLabeled: myLabel. cases := Array with: foundWindow . "For teardown." myModel := foundWindow submorphs detect: #isMorphicModel. self assert: myModel model class == Workspace. self assert: foundWindow model class == Workspace.! Item was changed: + ----- Method: MorphicUIManagerTest>>testOpenWorkspaceAns (in category 'tests') ----- - ----- Method: MorphicUIManagerTest>>testOpenWorkspaceAns (in category 'as yet unclassified') ----- testOpenWorkspaceAns "Test if method opening a workspace answers the window opened" "MorphicUIBugTest run: #testOpenWorkspaceAns" | window myLabel foundWindow | myLabel := 'Workspace from ', 'SUnit test' . foundWindow := self findWindowInWorldLabeled: myLabel . self assert: ( foundWindow isNil ) . window := uiManager edit: '"MorphicUIBugTest run: #openWorkspaceTest"' label: myLabel. foundWindow := self findWindowInWorldLabeled: myLabel . cases := Array with: foundWindow . "For teardown." self assert: ( window == foundWindow ) .! Item was changed: + ----- Method: MorphicUIManagerTest>>testShowAllBinParts (in category 'tests') ----- - ----- Method: MorphicUIManagerTest>>testShowAllBinParts (in category 'as yet unclassified') ----- testShowAllBinParts "self new testShowAllBinParts" "MorphicUIBugTest run: #testShowAllBinParts" | tool | self shouldnt: [tool := ObjectsTool initializedInstance showAll openCenteredInWorld] raise: Error. cases := Array with: tool.! Item was changed: + ----- Method: MorphicUIManagerTest>>testUIManagerNoAcceptInitially (in category 'tests') ----- - ----- Method: MorphicUIManagerTest>>testUIManagerNoAcceptInitially (in category 'as yet unclassified') ----- testUIManagerNoAcceptInitially "Ensure that UIManager does not invoke the accept: action initially." | accepted window | accepted := false. window := uiManager edit: Text new label: 'Test' accept: [:val| accepted := true]. window delete. self deny: accepted.! Item was changed: + ----- Method: SimpleSwitchMorphTest>>classToBeTested (in category 'accessing') ----- - ----- Method: SimpleSwitchMorphTest>>classToBeTested (in category 'as yet unclassified') ----- classToBeTested ^ SimpleSwitchMorph ! Item was changed: + ----- Method: SimpleSwitchMorphTest>>setUp (in category 'initialize-release') ----- - ----- Method: SimpleSwitchMorphTest>>setUp (in category 'as yet unclassified') ----- setUp super setUp. testSwitch := SimpleSwitchMorph new! Item was changed: + ----- Method: SimpleSwitchMorphTest>>testName (in category 'tests') ----- - ----- Method: SimpleSwitchMorphTest>>testName (in category 'as yet unclassified') ----- testName self assert: testSwitch externalName = 'SimpleSwitch'! Item was changed: + ----- Method: SimpleSwitchMorphTest>>testState (in category 'tests') ----- - ----- Method: SimpleSwitchMorphTest>>testState (in category 'as yet unclassified') ----- testState self assert: testSwitch isOff. self deny: testSwitch isOn. testSwitch toggleState. self assert: testSwitch isOn. self deny: testSwitch isOff! Item was changed: + ----- Method: SimpleSwitchMorphTest>>testSwitching (in category 'tests') ----- - ----- Method: SimpleSwitchMorphTest>>testSwitching (in category 'as yet unclassified') ----- testSwitching testSwitch setSwitchState: false. self assert: testSwitch isOff. self assert: testSwitch color = testSwitch offColor. testSwitch setSwitchState: true. self assert: testSwitch isOn. self assert: testSwitch color = testSwitch onColor.! Item was changed: + ----- Method: StickynessBugz>>testForTiltedStickyness (in category 'tests') ----- - ----- Method: StickynessBugz>>testForTiltedStickyness (in category 'as yet unclassified') ----- testForTiltedStickyness "self new testForTiltedStickyness" "self run: #testForTiltedStickyness" | m | m := RectangleMorph new openCenteredInWorld . cases := Array with: m . "save for tear down." self assert: ( m topRendererOrSelf isSticky not ) . m beSticky . self assert: ( m topRendererOrSelf isSticky ) . m addFlexShell . cases := Array with: m topRendererOrSelf . m topRendererOrSelf rotationDegrees: 45.0 . self assert: ( m topRendererOrSelf isSticky ) . m beUnsticky . self assert: ( m topRendererOrSelf isSticky not ) . m topRendererOrSelf delete. ^true ! Item was changed: + ----- Method: TestInWorldMorph>>initialize (in category 'initialization') ----- - ----- Method: TestInWorldMorph>>initialize (in category 'as yet unclassified') ----- initialize super initialize. outOfWorldCount := intoWorldCount := 0.! Item was changed: + ----- Method: TestInWorldMorph>>intoWorld: (in category 'accessing') ----- - ----- Method: TestInWorldMorph>>intoWorld: (in category 'as yet unclassified') ----- intoWorld: aWorld aWorld ifNil:[^self]. super intoWorld: aWorld. intoWorldCount := intoWorldCount + 1. ! Item was changed: + ----- Method: TestInWorldMorph>>intoWorldCount (in category 'accessing') ----- - ----- Method: TestInWorldMorph>>intoWorldCount (in category 'as yet unclassified') ----- intoWorldCount ^intoWorldCount! Item was changed: + ----- Method: TestInWorldMorph>>outOfWorld: (in category 'accessing') ----- - ----- Method: TestInWorldMorph>>outOfWorld: (in category 'as yet unclassified') ----- outOfWorld: aWorld aWorld ifNil:[^self]. super outOfWorld: aWorld. outOfWorldCount := outOfWorldCount + 1. ! Item was changed: + ----- Method: TestInWorldMorph>>outOfWorldCount (in category 'accessing') ----- - ----- Method: TestInWorldMorph>>outOfWorldCount (in category 'as yet unclassified') ----- outOfWorldCount ^outOfWorldCount! Item was changed: + ----- Method: UnimplementedCallBugz>>testPolyIntersect (in category 'tests') ----- - ----- Method: UnimplementedCallBugz>>testPolyIntersect (in category 'as yet unclassified') ----- testPolyIntersect "self run: #testPolyIntersect" "This should not throw an exception." PolygonMorph initializedInstance intersects: ( Rectangle center: Display center extent: 100 asPoint ).!

1 0

The Trunk: Kernel-eem.1100.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1100.mcz ==================== Summary ==================== Name: Kernel-eem.1100 Author: eem Time: 26 April 2017, 2:13:43.92511 pm UUID: d2281281-58ee-4fc0-a85f-32aa3c0063ca Ancestors: Kernel-ul.1099 Fix regression in Context printing introduced in Kernel-eem.1074 through Kernel-eem.1074 or there abouts. =============== Diff against Kernel-ul.1099 =============== Item was changed: ----- Method: Context>>printOn: (in category 'printing') ----- printOn: aStream | class mclass selector | method ifNil: [^super printOn: aStream]. closureOrNil ifNotNil: [aStream nextPutAll: '[] in '. + closureOrNil outerContext ifNotNil: + [:outer| + outer printOn: aStream. + ^self]]. - closureOrNil outerContext printOn: aStream]. class := self objectClass: self receiver. mclass := method methodClass. selector := method selector ifNil: [method defaultSelector]. aStream nextPutAll: class name. mclass ~~ class ifTrue: [aStream nextPut: $(; nextPutAll: mclass name; nextPut: $)]. aStream nextPutAll: '>>'; nextPutAll: selector. (selector == #doesNotUnderstand: and: [(self objectClass: (self tempAt: 1)) == Message]) ifTrue: [aStream space. (self tempAt: 1) selector printOn: aStream]!

1 0

The Trunk: EToys-nice.296.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-nice.296.mcz ==================== Summary ==================== Name: EToys-nice.296 Author: nice Time: 26 April 2017, 10:58:40.211195 pm UUID: 5d6e88cb-95d4-4aea-87f1-3e8e97c96a1b Ancestors: EToys-ul.295 Favour usage of the regular #findLastOccurrenceOfString:startingAt: over the (un-)deprecated #findLastOccuranceOfString:startingAt: =============== Diff against EToys-ul.295 =============== Item was changed: ----- Method: FileList>>removeVersionNumberFromFileName (in category '*Etoys-Squeakland-file menu action') ----- removeVersionNumberFromFileName "The selected filename has a version number in it. Rename the file such that the version number is removed." | localName fullName dotPosition beforeDot earlierDotPosition within newLocalName | fullName := directory fullNameFor: fileName. localName := FileDirectory localNameFor: fullName. dotPosition := localName findLastOccuranceOfString: FileDirectory dot startingAt: 1. dotPosition > 0 ifTrue: [beforeDot := localName copyFrom: 1 to: dotPosition - 1. + earlierDotPosition := beforeDot findLastOccurrenceOfString: FileDirectory dot startingAt: 1. - earlierDotPosition := beforeDot findLastOccuranceOfString: FileDirectory dot startingAt: 1. earlierDotPosition > 0 ifTrue: [within := beforeDot copyFrom: (earlierDotPosition + 1) to: beforeDot size. (within size > 0 and: [within isAllDigits]) ifTrue: ["whew" newLocalName := (localName copyFrom: 1 to: (earlierDotPosition - 1)), (localName copyFrom: dotPosition to: localName size). (directory fileNames includes: newLocalName) ifTrue: [(self confirm: ('do you want to clobber the existing' translated, ' ', newLocalName, '?') orCancel: [^ self]) ifFalse: [^ self]. directory deleteFileNamed: localName]. directory rename: localName toBe: newLocalName. self updateFileList]]]. !

3 2

The Trunk: EToys-nice.297.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-nice.297.mcz ==================== Summary ==================== Name: EToys-nice.297 Author: nice Time: 26 April 2017, 11:12:27.059817 pm UUID: b8866d63-4f7a-405c-b8a6-ae7a05c271a9 Ancestors: EToys-nice.296 Favour usage of the regular #findLastOccurrenceOfString:startingAt: over the (un-)deprecated #findLastOccuranceOfString:startingAt: BIS =============== Diff against EToys-nice.296 =============== Item was changed: ----- Method: FileList>>removeVersionNumberFromFileName (in category '*Etoys-Squeakland-file menu action') ----- removeVersionNumberFromFileName "The selected filename has a version number in it. Rename the file such that the version number is removed." | localName fullName dotPosition beforeDot earlierDotPosition within newLocalName | fullName := directory fullNameFor: fileName. localName := FileDirectory localNameFor: fullName. + dotPosition := localName findLastOccurrenceOfString: FileDirectory dot startingAt: 1. - dotPosition := localName findLastOccuranceOfString: FileDirectory dot startingAt: 1. dotPosition > 0 ifTrue: [beforeDot := localName copyFrom: 1 to: dotPosition - 1. earlierDotPosition := beforeDot findLastOccurrenceOfString: FileDirectory dot startingAt: 1. earlierDotPosition > 0 ifTrue: [within := beforeDot copyFrom: (earlierDotPosition + 1) to: beforeDot size. (within size > 0 and: [within isAllDigits]) ifTrue: ["whew" newLocalName := (localName copyFrom: 1 to: (earlierDotPosition - 1)), (localName copyFrom: dotPosition to: localName size). (directory fileNames includes: newLocalName) ifTrue: [(self confirm: ('do you want to clobber the existing' translated, ' ', newLocalName, '?') orCancel: [^ self]) ifFalse: [^ self]. directory deleteFileNamed: localName]. directory rename: localName toBe: newLocalName. self updateFileList]]]. !

1 0

The Trunk: MorphicExtras-nice.206.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-nice.206.mcz ==================== Summary ==================== Name: MorphicExtras-nice.206 Author: nice Time: 26 April 2017, 11:05:07.705923 pm UUID: d16239c9-452c-4885-93f9-0e7f7d6c59f8 Ancestors: MorphicExtras-ul.205 Classify a few 'as yet unclassified' methods =============== Diff against MorphicExtras-ul.205 =============== Item was changed: + ----- Method: AbstractMediaEventMorph>>endTime (in category 'accessing') ----- - ----- Method: AbstractMediaEventMorph>>endTime (in category 'as yet unclassified') ----- endTime ^endTimeInScore ifNil: [startTimeInScore + 100]! Item was changed: + ----- Method: DescriptionForPartsBin>>categories (in category 'accessing') ----- - ----- Method: DescriptionForPartsBin>>categories (in category 'access') ----- categories "Answer the categoryList of the receiver" ^ categoryList! Item was changed: + ----- Method: DescriptionForPartsBin>>documentation (in category 'accessing') ----- - ----- Method: DescriptionForPartsBin>>documentation (in category 'access') ----- documentation "Answer the documentation of the receiver" ^ documentation! Item was changed: + ----- Method: DescriptionForPartsBin>>formalName (in category 'accessing') ----- - ----- Method: DescriptionForPartsBin>>formalName (in category 'access') ----- formalName "Answer the formalName of the receiver" ^ formalName! Item was changed: + ----- Method: DescriptionForPartsBin>>globalReceiverSymbol (in category 'accessing') ----- - ----- Method: DescriptionForPartsBin>>globalReceiverSymbol (in category 'access') ----- globalReceiverSymbol "Answer the globalReceiverSymbol of the receiver" ^ globalReceiverSymbol! Item was changed: + ----- Method: DescriptionForPartsBin>>nativitySelector (in category 'accessing') ----- - ----- Method: DescriptionForPartsBin>>nativitySelector (in category 'access') ----- nativitySelector "Answer the nativitySelector of the receiver" ^ nativitySelector! Item was changed: + ----- Method: DescriptionForPartsBin>>translatedCategories (in category 'accessing') ----- - ----- Method: DescriptionForPartsBin>>translatedCategories (in category 'access') ----- translatedCategories "Answer translated the categoryList of the receiver" ^ self categories collect: [:each | each translated]! Item was changed: + ----- Method: EnvelopeLineMorph>>vertices:borderWidth:borderColor: (in category 'initialization') ----- - ----- Method: EnvelopeLineMorph>>vertices:borderWidth:borderColor: (in category 'as yet unclassified') ----- vertices: verts borderWidth: bw borderColor: bc super initialize. vertices := verts. borderWidth := bw. borderColor := bc. closed := false. arrows := #none. self computeBounds! Item was changed: + ----- Method: FancyMailComposition>>subject (in category 'accessing') ----- - ----- Method: FancyMailComposition>>subject (in category 'access') ----- subject ^subject ! Item was changed: + ----- Method: FancyMailComposition>>subject: (in category 'accessing') ----- - ----- Method: FancyMailComposition>>subject: (in category 'access') ----- subject: x subject := x. self changed: #subject. ^true! Item was changed: + ----- Method: FancyMailComposition>>to (in category 'accessing') ----- - ----- Method: FancyMailComposition>>to (in category 'access') ----- to ^to! Item was changed: + ----- Method: FancyMailComposition>>to: (in category 'accessing') ----- - ----- Method: FancyMailComposition>>to: (in category 'access') ----- to: x to := x. self changed: #to. ^true ! Item was changed: + ----- Method: FlexMorph>>changeBorderColor: (in category 'menus') ----- - ----- Method: FlexMorph>>changeBorderColor: (in category 'as yet unclassified') ----- changeBorderColor: evt | aHand | aHand := evt ifNotNil: [evt hand] ifNil: [self primaryHand]. self changeColorTarget: self selector: #borderColor: originalColor: self borderColor hand: aHand.! Item was changed: + ----- Method: FlexMorph>>changeBorderWidth: (in category 'menus') ----- - ----- Method: FlexMorph>>changeBorderWidth: (in category 'as yet unclassified') ----- changeBorderWidth: evt | handle origin aHand | aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin := aHand position. handle := HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). self borderWidth: (newPoint - origin) r asInteger // 5]. aHand attachMorph: handle. handle startStepping! Item was changed: + ----- Method: FlexMorph>>loadOriginalForm (in category 'private') ----- - ----- Method: FlexMorph>>loadOriginalForm (in category 'as yet unclassified') ----- loadOriginalForm originalForm ifNil: [self updateFromOriginal]. ! Item was changed: + ----- Method: FlexMorph>>originalMorph (in category 'accessing') ----- - ----- Method: FlexMorph>>originalMorph (in category 'as yet unclassified') ----- originalMorph ^ originalMorph! Item was changed: + ----- Method: FlexMorph>>originalMorph: (in category 'accessing') ----- - ----- Method: FlexMorph>>originalMorph: (in category 'as yet unclassified') ----- originalMorph: aMorph originalMorph := aMorph. scalePoint := 0.25(a)0.25. self updateFromOriginal.! Item was changed: + ----- Method: FlexMorph>>updateFromOriginal (in category 'private') ----- - ----- Method: FlexMorph>>updateFromOriginal (in category 'as yet unclassified') ----- updateFromOriginal | intermediateForm | intermediateForm := originalMorph imageForm offset: 0@0. intermediateForm border: intermediateForm boundingBox widthRectangle: (borderWidth corner: borderWidth+1) rule: Form over fillColor: borderColor. self form: intermediateForm. originalMorph fullReleaseCachedState! Item was changed: + ----- Method: GraphicalMenu>>argument (in category 'accessing') ----- - ----- Method: GraphicalMenu>>argument (in category 'as yet unclassified') ----- argument ^argument! Item was changed: + ----- Method: GraphicalMenu>>argument: (in category 'accessing') ----- - ----- Method: GraphicalMenu>>argument: (in category 'as yet unclassified') ----- argument: anObject argument := anObject! Item was changed: + ----- Method: GraphicalMenu>>cancel (in category 'event handling') ----- - ----- Method: GraphicalMenu>>cancel (in category 'as yet unclassified') ----- cancel coexistWithOriginal ifTrue: [self delete] ifFalse: [owner replaceSubmorph: self topRendererOrSelf by: target]! Item was changed: + ----- Method: GraphicalMenu>>downArrowHit (in category 'event handling') ----- - ----- Method: GraphicalMenu>>downArrowHit (in category 'as yet unclassified') ----- downArrowHit currentIndex := currentIndex - 1. (currentIndex < 1) ifTrue: [currentIndex := formChoices size]. self updateThumbnail ! Item was changed: + ----- Method: GraphicalMenu>>okay (in category 'event handling') ----- - ----- Method: GraphicalMenu>>okay (in category 'as yet unclassified') ----- okay | nArgs | target ifNotNil:[ nArgs := selector numArgs. nArgs = 1 ifTrue:[target perform: selector with: (formChoices at: currentIndex)]. nArgs = 2 ifTrue:[target perform: selector with: (formChoices at: currentIndex) with: argument]]. coexistWithOriginal ifTrue: [self delete] ifFalse: [owner replaceSubmorph: self topRendererOrSelf by: target]! Item was changed: + ----- Method: GraphicalMenu>>selector (in category 'accessing') ----- - ----- Method: GraphicalMenu>>selector (in category 'as yet unclassified') ----- selector ^selector! Item was changed: + ----- Method: GraphicalMenu>>selector: (in category 'accessing') ----- - ----- Method: GraphicalMenu>>selector: (in category 'as yet unclassified') ----- selector: aSymbol selector := aSymbol! Item was changed: + ----- Method: GraphicalMenu>>upArrowHit (in category 'event handling') ----- - ----- Method: GraphicalMenu>>upArrowHit (in category 'as yet unclassified') ----- upArrowHit currentIndex := currentIndex + 1. (currentIndex > formChoices size) ifTrue: [currentIndex := 1]. self updateThumbnail ! Item was changed: + ----- Method: InterimSoundMorph>>addGraphic (in category 'initialization') ----- - ----- Method: InterimSoundMorph>>addGraphic (in category 'as yet unclassified') ----- addGraphic graphic := SketchMorph withForm: self speakerGraphic. graphic position: bounds center - (graphic extent // 2). self addMorph: graphic. ! Item was changed: + ----- Method: InterimSoundMorph>>sound (in category 'accessing') ----- - ----- Method: InterimSoundMorph>>sound (in category 'as yet unclassified') ----- sound ^ sound ! Item was changed: + ----- Method: InterimSoundMorph>>sound: (in category 'accessing') ----- - ----- Method: InterimSoundMorph>>sound: (in category 'as yet unclassified') ----- sound: aSound sound := aSound. ! Item was changed: + ----- Method: InterimSoundMorph>>speakerGraphic (in category 'initialization') ----- - ----- Method: InterimSoundMorph>>speakerGraphic (in category 'as yet unclassified') ----- speakerGraphic ^ Form extent: 19@18 depth: 8 fromArray: #(0 0 1493172224 2816 0 0 0 1493172224 11 0 0 138 1493172224 184549376 184549376 0 35509 2315255808 720896 720896 0 9090522 2315255808 2816 720896 0 2327173887 2315255819 2816 720896 138 3051028442 2315255819 2816 2816 1505080590 4294957786 2315255808 184549387 2816 3053453311 4292532917 1493172224 184549387 2816 1505080714 3048584629 1493172224 184549387 2816 9079434 3048584629 1493172224 184549387 2816 138 2327164341 1493172235 2816 2816 0 2324346293 1493172235 2816 720896 0 9079477 1493172224 2816 720896 0 35466 1493172224 720896 720896 0 138 0 184549376 184549376 0 0 0 11 0 0 0 0 2816 0) offset: 0@0 ! Item was changed: + ----- Method: MultiResolutionCanvas>>deferredMorphs (in category 'accessing') ----- - ----- Method: MultiResolutionCanvas>>deferredMorphs (in category 'as yet unclassified') ----- deferredMorphs ^deferredMorphs! Item was changed: + ----- Method: MultiResolutionCanvas>>deferredMorphs: (in category 'accessing') ----- - ----- Method: MultiResolutionCanvas>>deferredMorphs: (in category 'as yet unclassified') ----- deferredMorphs: aCollection deferredMorphs := aCollection! Item was changed: + ----- Method: MultiResolutionCanvas>>initializeFrom: (in category 'initialize-release') ----- - ----- Method: MultiResolutionCanvas>>initializeFrom: (in category 'as yet unclassified') ----- initializeFrom: aFormCanvas origin := aFormCanvas origin. clipRect := aFormCanvas privateClipRect. form := aFormCanvas form. port := aFormCanvas privatePort. shadowColor := aFormCanvas shadowColor. ! Item was changed: + ----- Method: SoundEventMorph>>sound: (in category 'accessing') ----- - ----- Method: SoundEventMorph>>sound: (in category 'as yet unclassified') ----- sound: aSound sound := aSound. self setBalloonText: 'a sound of duration ',(sound duration printShowingMaxDecimalPlaces: 1),' seconds'.! Item was changed: + ----- Method: SoundLoopMorph>>addCursorMorph (in category 'initialization') ----- - ----- Method: SoundLoopMorph>>addCursorMorph (in category 'as yet unclassified') ----- addCursorMorph self addMorph: (cursor := (RectangleMorph newBounds: (self innerBounds topLeft extent: 1@self innerBounds height) color: Color red) borderWidth: 0)! Item was changed: + ----- Method: SoundLoopMorph>>allowSubmorphExtraction (in category 'dropping/grabbing') ----- - ----- Method: SoundLoopMorph>>allowSubmorphExtraction (in category 'as yet unclassified') ----- allowSubmorphExtraction ^ true! Item was changed: + ----- Method: SoundLoopMorph>>buildSound (in category 'playing') ----- - ----- Method: SoundLoopMorph>>buildSound (in category 'as yet unclassified') ----- buildSound "Build a compound sound for the next iteration of the loop." | mixer soundMorphs | mixer := MixedSound new. mixer add: (RestSound dur: (self width - (2 * borderWidth)) / 128.0). soundMorphs := self submorphs select: [:m | m respondsTo: #sound]. soundMorphs do: [:m | | startTime pan | startTime := (m position x - (self left + borderWidth)) / 128.0. pan := (m position y - (self top + borderWidth)) asFloat / (self height - (2 * borderWidth) - m height). mixer add: ((RestSound dur: startTime), m sound copy) pan: pan]. ^ mixer ! Item was changed: + ----- Method: SoundLoopMorph>>play (in category 'playing') ----- - ----- Method: SoundLoopMorph>>play (in category 'as yet unclassified') ----- play "Play this sound to the sound ouput port in real time." self reset. SoundPlayer playSound: self. ! Item was changed: + ----- Method: SquishedNameMorph>>colorAroundName (in category 'drawing') ----- - ----- Method: SquishedNameMorph>>colorAroundName (in category 'as yet unclassified') ----- colorAroundName ^Color gray: 0.8! Item was changed: + ----- Method: SquishedNameMorph>>fontForName (in category 'drawing') ----- - ----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') ----- fontForName ^(TextStyle default fontOfSize: 15) emphasized: 1 ! Item was changed: + ----- Method: SquishedNameMorph>>isEditingName (in category 'drawing') ----- - ----- Method: SquishedNameMorph>>isEditingName (in category 'as yet unclassified') ----- isEditingName ^((self findA: UpdatingStringMorph) ifNil: [^false]) hasFocus ! Item was changed: + ----- Method: SquishedNameMorph>>stringToShow (in category 'drawing') ----- - ----- Method: SquishedNameMorph>>stringToShow (in category 'as yet unclassified') ----- stringToShow (target isNil or: [getSelector isNil]) ifTrue: [^'????']. ^target perform: getSelector! Item was changed: + ----- Method: SquishedNameMorph>>target:getSelector:setSelector: (in category 'initialization') ----- - ----- Method: SquishedNameMorph>>target:getSelector:setSelector: (in category 'as yet unclassified') ----- target: aTarget getSelector: symbol1 setSelector: symbol2 target := aTarget. getSelector := symbol1. setSelector := symbol2.! Item was changed: + ----- Method: StoryboardBookMorph>>changeTiltFactor: (in category 'private') ----- - ----- Method: StoryboardBookMorph>>changeTiltFactor: (in category 'as yet unclassified') ----- changeTiltFactor: x currentPage changeTiltFactor: x. panAndTiltFactor := x. ! Item was changed: + ----- Method: StoryboardBookMorph>>changeZoomFactor: (in category 'private') ----- - ----- Method: StoryboardBookMorph>>changeZoomFactor: (in category 'as yet unclassified') ----- changeZoomFactor: x currentPage changeZoomFactor: x. zoomFactor := x.! Item was changed: + ----- Method: StoryboardBookMorph>>getTiltFactor (in category 'private') ----- - ----- Method: StoryboardBookMorph>>getTiltFactor (in category 'as yet unclassified') ----- getTiltFactor ^panAndTiltFactor ifNil: [panAndTiltFactor := 0.5].! Item was changed: + ----- Method: StoryboardBookMorph>>getZoomFactor (in category 'private') ----- - ----- Method: StoryboardBookMorph>>getZoomFactor (in category 'as yet unclassified') ----- getZoomFactor ^zoomFactor ifNil: [zoomFactor := 0.5]! Item was changed: + ----- Method: StoryboardBookMorph>>offsetX (in category 'accessing') ----- - ----- Method: StoryboardBookMorph>>offsetX (in category 'as yet unclassified') ----- offsetX ^currentPage offsetX! Item was changed: + ----- Method: StoryboardBookMorph>>offsetX: (in category 'accessing') ----- - ----- Method: StoryboardBookMorph>>offsetX: (in category 'as yet unclassified') ----- offsetX: aNumber currentPage offsetX: aNumber! Item was changed: + ----- Method: StoryboardBookMorph>>offsetY (in category 'accessing') ----- - ----- Method: StoryboardBookMorph>>offsetY (in category 'as yet unclassified') ----- offsetY ^currentPage offsetY! Item was changed: + ----- Method: StoryboardBookMorph>>offsetY: (in category 'accessing') ----- - ----- Method: StoryboardBookMorph>>offsetY: (in category 'as yet unclassified') ----- offsetY: aNumber currentPage offsetY: aNumber! Item was changed: + ----- Method: StoryboardBookMorph>>scale (in category 'accessing') ----- - ----- Method: StoryboardBookMorph>>scale (in category 'as yet unclassified') ----- scale ^currentPage scale! Item was changed: + ----- Method: StoryboardBookMorph>>scale: (in category 'accessing') ----- - ----- Method: StoryboardBookMorph>>scale: (in category 'as yet unclassified') ----- scale: aValue currentPage scale: aValue! Item was changed: + ----- Method: TextOnCurve>>composeLinesFrom:withLines:atY: (in category 'composition') ----- - ----- Method: TextOnCurve>>composeLinesFrom:withLines:atY: (in category 'as yet unclassified') ----- composeLinesFrom: startingIndex withLines: startingLines atY: startingY "Here we determine the 'lines' of text that will fit along each segment of the curve. For each line, we determine its rectangle, then the dest wuadrilateral that it willbe rotated to. Then, we take the outer hull to determine a dest rectangle for WarpBlt. In addition we need the segment pivot point and angle, from which the source quadrilateral may be computed." | charIndex scanner line firstLine curveSegments segIndex pa pb segLen lineRect textSegments segDelta segAngle destRect destQuad i oldBounds | (oldBounds := container bounds) ifNotNil: [curve invalidRect: oldBounds]. charIndex := startingIndex. lines := startingLines. curveSegments := curve lineSegments. container textDirection < 0 ifTrue: [curveSegments := curveSegments reversed collect: [:seg | Array with: (seg second) with: seg first]]. textSegments := OrderedCollection new. scanner := SegmentScanner new text: text textStyle: textStyle. segIndex := 1. "For curves, segIndex is just an index." firstLine := true. pa := curveSegments first first. [charIndex <= text size and: [segIndex <= curveSegments size]] whileTrue: [curve isCurve ifFalse: [pa := (curveSegments at: segIndex) first]. pb := (curveSegments at: segIndex) last. segDelta := pb - pa. "Direction of this segment" segLen := segDelta r. lineRect := 0 @ 0 extent: segLen asInteger @ textStyle lineGrid. line := scanner composeFrom: charIndex inRectangle: lineRect firstLine: firstLine leftSide: true rightSide: true. line setRight: scanner rightX. line width > 0 ifTrue: [lines addLast: line. segAngle := segDelta theta. destQuad := line rectangle corners collect: [:p | (p translateBy: pa - (0 @ (line baseline + container baseline))) rotateBy: segAngle negated about: pa]. destRect := Rectangle encompassing: destQuad. textSegments addLast: (Array with: destRect truncated with: pa with: segAngle). pa := pa + ((pb - pa) * line width / segLen). charIndex := line last + 1]. segIndex := segIndex + 1. firstLine := false]. lines isEmpty ifTrue: ["No space in container or empty text" line := (TextLine start: startingIndex stop: startingIndex - 1 internalSpaces: 0 paddingWidth: 0) rectangle: (0 @ 0 extent: 10 @ textStyle lineGrid); lineHeight: textStyle lineGrid baseline: textStyle baseline. lines := Array with: line. textSegments addLast: (Array with: (curve vertices first extent: line rectangle extent) with: curve vertices first with: 0.0)]. "end of segments, now attempt word break." lines last last < text size ifTrue: [ [lines size > 1 and: [(text at: (i := lines last last) + 1) ~= Character space]] whileTrue: [i = lines last first ifTrue: [lines removeLast. textSegments removeLast] ifFalse: [lines last stop: i - 1]]]. lines := lines asArray. container textSegments: textSegments asArray. curve invalidRect: container bounds. ^maxRightX! Item was changed: + ----- Method: TextOnCurve>>extent (in category 'accessing') ----- - ----- Method: TextOnCurve>>extent (in category 'access') ----- extent ^ curve bounds extent! Item was changed: + ----- Method: TextOnCurve>>pointInLine:forDestPoint:segStart:segAngle: (in category 'private') ----- - ----- Method: TextOnCurve>>pointInLine:forDestPoint:segStart:segAngle: (in category 'as yet unclassified') ----- pointInLine: line forDestPoint: p segStart: segStart segAngle: segAngle ^ (p rotateBy: segAngle about: segStart) translateBy: (0@(line baseline + container baseline)) - segStart! Item was changed: + ----- Method: TextOnCurve>>releaseCachedState (in category 'caching') ----- - ----- Method: TextOnCurve>>releaseCachedState (in category 'as yet unclassified') ----- releaseCachedState super releaseCachedState. CachedWarpMap := CachedWarpDepth := CachedWarpColor := nil! Item was changed: + ----- Method: TextOnCurve>>textOwner: (in category 'accessing') ----- - ----- Method: TextOnCurve>>textOwner: (in category 'access') ----- textOwner: theCurve curve := theCurve! Item was changed: + ----- Method: TextOnCurve>>textSegmentsDo: (in category 'private') ----- - ----- Method: TextOnCurve>>textSegmentsDo: (in category 'as yet unclassified') ----- textSegmentsDo: blockForLineDestPivotAngle | segments segSpec | (segments := container textSegments) ifNil: [^self]. 1 to: lines size do: [:i | segSpec := segments at: i. blockForLineDestPivotAngle value: (lines at: i) value: (segSpec first) value: (segSpec second) value: (segSpec third)]! Item was changed: + ----- Method: TextOnCurve>>warpMapForDepth:withTransparentFor: (in category 'private') ----- - ----- Method: TextOnCurve>>warpMapForDepth:withTransparentFor: (in category 'as yet unclassified') ----- warpMapForDepth: destDepth withTransparentFor: bkgndColor (CachedWarpDepth = destDepth and: [CachedWarpColor = bkgndColor]) ifTrue: ["Map is OK as is -- return it" ^CachedWarpMap]. (CachedWarpMap isNil or: [CachedWarpDepth ~= destDepth]) ifTrue: ["Have to recreate the map" CachedWarpMap := Color computeColormapFrom: 32 to: destDepth. CachedWarpDepth := destDepth] ifFalse: ["Map is OK, if we restore prior color substiution" CachedWarpMap at: (CachedWarpColor indexInMap: CachedWarpMap) put: (CachedWarpColor pixelValueForDepth: destDepth)]. "Now map the background color into transparent, and return the new map" CachedWarpColor := bkgndColor. CachedWarpMap at: (CachedWarpColor indexInMap: CachedWarpMap) put: 0. ^CachedWarpMap! Item was changed: + ----- Method: TextOnCurveContainer>>baseline (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>baseline (in category 'as yet unclassified') ----- baseline baseline ifNil: [^ 0]. ^ baseline! Item was changed: + ----- Method: TextOnCurveContainer>>baseline: (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>baseline: (in category 'as yet unclassified') ----- baseline: newBaseline baseline := newBaseline! Item was changed: + ----- Method: TextOnCurveContainer>>bounds (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>bounds (in category 'as yet unclassified') ----- bounds textSegments ifNil: [^nil]. ^textSegments inject: (textSegments first first) into: [:bnd :each | bnd merge: (each first)]! Item was changed: + ----- Method: TextOnCurveContainer>>paragraphClass (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>paragraphClass (in category 'as yet unclassified') ----- paragraphClass ^ TextOnCurve! Item was changed: + ----- Method: TextOnCurveContainer>>releaseCachedState (in category 'caching') ----- - ----- Method: TextOnCurveContainer>>releaseCachedState (in category 'as yet unclassified') ----- releaseCachedState textSegments := nil.! Item was changed: + ----- Method: TextOnCurveContainer>>textDirection (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>textDirection (in category 'as yet unclassified') ----- textDirection ^ textDirection! Item was changed: + ----- Method: TextOnCurveContainer>>textDirection: (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>textDirection: (in category 'as yet unclassified') ----- textDirection: plusOrMinusOne textDirection := plusOrMinusOne! Item was changed: + ----- Method: TextOnCurveContainer>>textSegments (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>textSegments (in category 'as yet unclassified') ----- textSegments ^ textSegments! Item was changed: + ----- Method: TextOnCurveContainer>>textSegments: (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>textSegments: (in category 'as yet unclassified') ----- textSegments: segments textSegments := segments! Item was changed: + ----- Method: TextOnCurveContainer>>top (in category 'accessing') ----- - ----- Method: TextOnCurveContainer>>top (in category 'as yet unclassified') ----- top ^ 1 "for compatibility"! Item was changed: + ----- Method: TextOnCurveContainer>>translateBy: (in category 'transforming') ----- - ----- Method: TextOnCurveContainer>>translateBy: (in category 'as yet unclassified') ----- translateBy: delta textSegments isNil ifTrue: [^self]. textSegments := textSegments collect: [:ls | Array with: (ls first translateBy: delta) with: (ls second translateBy: delta) with: ls third]! Item was changed: + ----- Method: TransformationB2Morph>>useRegularWarpBlt: (in category 'accessing') ----- - ----- Method: TransformationB2Morph>>useRegularWarpBlt: (in category 'as yet unclassified') ----- useRegularWarpBlt: aBoolean useRegularWarpBlt := aBoolean! Item was changed: + ----- Method: ZASMStepsMorph>>getStepCount (in category 'accessing') ----- - ----- Method: ZASMStepsMorph>>getStepCount (in category 'as yet unclassified') ----- getStepCount ^[self contents asNumber] ifError: [ :a :b | 10] ! Item was changed: + ----- Method: ZASMStepsMorph>>setStepCount: (in category 'accessing') ----- - ----- Method: ZASMStepsMorph>>setStepCount: (in category 'as yet unclassified') ----- setStepCount: n self contents: n printString. !

1 0

The Trunk: Graphics-nice.374.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.374.mcz ==================== Summary ==================== Name: Graphics-nice.374 Author: nice Time: 26 April 2017, 11:03:04.6544 pm UUID: 7b1aeafa-4b31-4143-9add-cba95d9617f1 Ancestors: Graphics-ul.373 Classify a few 'as yet unclassified' methods =============== Diff against Graphics-ul.373 =============== Item was changed: + ----- Method: Color>>alpha (in category 'accessing') ----- - ----- Method: Color>>alpha (in category 'access') ----- alpha "Return the opacity ('alpha') value of opaque so that normal colors can be compared to TransparentColors." ^ 1.0 ! Item was changed: + ----- Method: Color>>blue (in category 'accessing') ----- - ----- Method: Color>>blue (in category 'access') ----- blue "Return the blue component of this color, a float in the range [0.0..1.0]." ^ self privateBlue asFloat / ComponentMax! Item was changed: + ----- Method: Color>>brightness (in category 'accessing') ----- - ----- Method: Color>>brightness (in category 'access') ----- brightness "Return the brightness of this color, a float in the range [0.0..1.0]." ^ ((self privateRed max: self privateGreen) max: self privateBlue) asFloat / ComponentMax! Item was changed: + ----- Method: Color>>green (in category 'accessing') ----- - ----- Method: Color>>green (in category 'access') ----- green "Return the green component of this color, a float in the range [0.0..1.0]." ^ self privateGreen asFloat / ComponentMax! Item was changed: + ----- Method: Color>>hue (in category 'accessing') ----- - ----- Method: Color>>hue (in category 'access') ----- hue "Return the hue of this color, an angle in the range [0.0..360.0]." | r g b max min span h | r := self privateRed. g := self privateGreen. b := self privateBlue. max := ((r max: g) max: b). min := ((r min: g) min: b). span := (max - min) asFloat. span = 0.0 ifTrue: [ ^ 0.0 ]. r = max ifTrue: [ h := ((g - b) asFloat / span) * 60.0. ] ifFalse: [ g = max ifTrue: [ h := 120.0 + (((b - r) asFloat / span) * 60.0). ] ifFalse: [ h := 240.0 + (((r - g) asFloat / span) * 60.0). ]. ]. h < 0.0 ifTrue: [ h := 360.0 + h ]. ^ h! Item was changed: + ----- Method: Color>>luminance (in category 'accessing') ----- - ----- Method: Color>>luminance (in category 'access') ----- luminance "Return the luminance of this color, a brightness value weighted by the human eye's color sensitivity." ^ ((299 * self privateRed) + (587 * self privateGreen) + (114 * self privateBlue)) / (1000 * ComponentMax) ! Item was changed: + ----- Method: Color>>red (in category 'accessing') ----- - ----- Method: Color>>red (in category 'access') ----- red "Return the red component of this color, a float in the range [0.0..1.0]." ^ self privateRed asFloat / ComponentMax! Item was changed: + ----- Method: Color>>saturation (in category 'accessing') ----- - ----- Method: Color>>saturation (in category 'access') ----- saturation "Return the saturation of this color, a value between 0.0 and 1.0." | r g b max min | r := self privateRed. g := self privateGreen. b := self privateBlue. max := min := r. g > max ifTrue: [max := g]. b > max ifTrue: [max := b]. g < min ifTrue: [min := g]. b < min ifTrue: [min := b]. max = 0 ifTrue: [ ^ 0.0 ] ifFalse: [ ^ (max - min) asFloat / max asFloat ]. ! Item was changed: + ----- Method: FormSetFont>>displayString:on:from:to:at:kern: (in category 'displaying') ----- - ----- Method: FormSetFont>>displayString:on:from:to:at:kern: (in category 'as yet unclassified') ----- displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta "Draw the given string from startIndex to stopIndex " combinationRule ifNotNil: [:r | aBitBlt combinationRule: r]. tintable == false ifTrue: [aBitBlt colorMap: nil]. ^ super displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta! Item was changed: + ----- Method: FormSetFont>>fromFormArray:asciiStart:ascent: (in category 'initialize-release') ----- - ----- Method: FormSetFont>>fromFormArray:asciiStart:ascent: (in category 'as yet unclassified') ----- fromFormArray: formArray asciiStart: asciiStart ascent: ascentVal | height width x badChar | type := 2. name := 'aFormFont'. minAscii := asciiStart. maxAscii := minAscii + formArray size - 1. ascent := ascentVal. subscript := superscript := emphasis := 0. height := width := 0. maxWidth := 0. formArray do: [:f | width := width + f width. maxWidth := maxWidth max: f width. height := height max: f height + f offset y]. badChar := (Form extent: 7@height) borderWidth: 1. width := width + badChar width. descent := height - ascent. pointSize := height. glyphs := Form extent: width @ height depth: formArray first depth. xTable := Array new: maxAscii + 3 withAll: 0. x := 0. formArray doWithIndex: [:f :i | f displayOn: glyphs at: x@0. xTable at: minAscii + i+1 put: (x := x + f width)]. badChar displayOn: glyphs at: x@0. xTable at: maxAscii + 3 put: x + badChar width. characterToGlyphMap := nil.! Item was changed: + ----- Method: FormSetFont>>initialize (in category 'initialize-release') ----- - ----- Method: FormSetFont>>initialize (in category 'as yet unclassified') ----- initialize super initialize. self preserveColors.! Item was changed: + ----- Method: FormSetFont>>reset (in category 'emphasis') ----- - ----- Method: FormSetFont>>reset (in category 'as yet unclassified') ----- reset "Ignored by FormSetFonts"! Item was changed: + ----- Method: IdentityGlyphMap>>at: (in category 'accessing') ----- - ----- Method: IdentityGlyphMap>>at: (in category 'as yet unclassified') ----- at: index ^ index - 1. ! Item was changed: + ----- Method: InfiniteForm>>addFillStyleMenuItems:hand:from: (in category 'Morphic menu') ----- - ----- Method: InfiniteForm>>addFillStyleMenuItems:hand:from: (in category 'as yet unclassified') ----- addFillStyleMenuItems: aMenu hand: aHand from: aMorph "Add the items for changing the current fill style of the receiver" "prevents a walkback when control menu is built for morph with me as color"! Item was changed: + ----- Method: StaticForm>>isStatic (in category 'testing') ----- - ----- Method: StaticForm>>isStatic (in category 'as yet unclassified') ----- isStatic ^true! Item was changed: + ----- Method: TextComposer>>addNullLineForIndex: (in category 'private') ----- - ----- Method: TextComposer>>addNullLineForIndex: (in category 'as yet unclassified') ----- addNullLineForIndex: index "This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I couldn't figure out where to put it in the main logic." | oldLastLine r | oldLastLine := lines last. oldLastLine last - oldLastLine first >= 0 ifFalse: [^self]. oldLastLine last = (index - 1) ifFalse: [^self]. r := oldLastLine left @ oldLastLine bottom extent: 0@(oldLastLine bottom - oldLastLine top). "Even though we may be below the bottom of the container, it is still necessary to compose the last line for consistency..." self addNullLineWithIndex: index andRectangle: r. ! Item was changed: + ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'private') ----- - ----- Method: TextComposer>>addNullLineWithIndex:andRectangle: (in category 'as yet unclassified') ----- addNullLineWithIndex: index andRectangle: r lines addLast: ( ( TextLine start: index stop: index - 1 internalSpaces: 0 paddingWidth: 0 ) rectangle: r; lineHeight: defaultLineHeight baseline: theTextStyle baseline ) ! Item was changed: + ----- Method: TextComposer>>checkIfReadyToSlide (in category 'private') ----- - ----- Method: TextComposer>>checkIfReadyToSlide (in category 'as yet unclassified') ----- checkIfReadyToSlide "Check whether we are now in sync with previously composed lines" (possibleSlide and: [currCharIndex > stopCharIndex]) ifFalse: [^self]. [prevIndex < prevLines size and: [(prevLines at: prevIndex) first < (currCharIndex - deltaCharIndex)]] whileTrue: [prevIndex := prevIndex + 1]. (prevLines at: prevIndex) first = (currCharIndex - deltaCharIndex) ifTrue: [ "Yes -- next line will have same start as prior line." prevIndex := prevIndex - 1. possibleSlide := false. nowSliding := true ] ifFalse: [ prevIndex = prevLines size ifTrue: [ "Weve reached the end of prevLines, so no use to keep looking for lines to slide." possibleSlide := false ] ]! Item was changed: + ----- Method: TextComposer>>composeAllLines (in category 'private') ----- - ----- Method: TextComposer>>composeAllLines (in category 'as yet unclassified') ----- composeAllLines [currCharIndex <= theText size and: [(currentY + defaultLineHeight) <= theContainer bottom]] whileTrue: [ nowSliding ifTrue: [ self slideOneLineDown ifNil: [^nil]. ] ifFalse: [ self composeOneLine ifNil: [^nil]. ] ]. ! Item was changed: + ----- Method: TextComposer>>composeAllRectangles: (in category 'private') ----- - ----- Method: TextComposer>>composeAllRectangles: (in category 'as yet unclassified') ----- composeAllRectangles: rectangles | charIndexBeforeLine numberOfLinesBefore reasonForStopping | actualHeight := defaultLineHeight. charIndexBeforeLine := currCharIndex. numberOfLinesBefore := lines size. reasonForStopping := self composeEachRectangleIn: rectangles. currentY := currentY + actualHeight. currentY > theContainer bottom ifTrue: [ "Oops -- the line is really too high to fit -- back out" currCharIndex := charIndexBeforeLine. lines size - numberOfLinesBefore timesRepeat: [lines removeLast]. ^self ]. "It's OK -- the line still fits." maxRightX := maxRightX max: scanner rightX. 1 to: rectangles size - 1 do: [ :i | |lineIndex| "Adjust heights across rectangles if necessary" lineIndex:=lines size - rectangles size + i. (lines size between: 1 and: lineIndex) ifTrue: [(lines at: lineIndex) lineHeight: lines last lineHeight baseline: lines last baseline] ]. isFirstLine := false. reasonForStopping == #columnBreak ifTrue: [^nil]. currCharIndex > theText size ifTrue: [ ^nil "we are finished composing" ]. ! Item was changed: + ----- Method: TextComposer>>composeEachRectangleIn: (in category 'private') ----- - ----- Method: TextComposer>>composeEachRectangleIn: (in category 'as yet unclassified') ----- composeEachRectangleIn: rectangles | myLine lastChar | 1 to: rectangles size do: [:i | currCharIndex <= theText size ifFalse: [^false]. myLine := scanner composeFrom: currCharIndex inRectangle: (rectangles at: i) firstLine: isFirstLine leftSide: i=1 rightSide: i=rectangles size. lines addLast: myLine. actualHeight := actualHeight max: myLine lineHeight. "includes font changes" currCharIndex := myLine last + 1. lastChar := theText at: myLine last. (CharacterSet crlf includes: lastChar) ifTrue: [^#cr]. wantsColumnBreaks ifTrue: [ lastChar = Character characterForColumnBreak ifTrue: [^#columnBreak]. ]. ]. ^false! Item was changed: + ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'composing') ----- - ----- Method: TextComposer>>composeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') ----- composeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks wantsColumnBreaks := argWantsColumnBreaks. lines := argLinesCollection. theTextStyle := argTextStyle. theText := argText. theContainer := argContainer. deltaCharIndex := argDelta. currCharIndex := startCharIndex := argStart. stopCharIndex := argStop. prevLines := argPriorLines. currentY := argStartY. maxRightX := theContainer left. possibleSlide := stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle]. nowSliding := false. prevIndex := 1. "choose an appropriate scanner - should go away soon, when they can be unified" scanner := CompositionScanner new. scanner text: theText textStyle: theTextStyle. scanner wantsColumnBreaks: wantsColumnBreaks. defaultLineHeight := scanner computeDefaultLineHeight. isFirstLine := true. self composeAllLines. isFirstLine ifTrue: ["No space in container or empty text" self addNullLineWithIndex: startCharIndex andRectangle: (theContainer left @ theContainer top extent: 0@defaultLineHeight) ] ifFalse: [ (lines last last = theText size and: [scanner doesTheLineBreaksAfterLastChar]) ifTrue: [self addNullLineForIndex: theText size + 1] ]. ^{lines asArray. maxRightX} ! Item was changed: + ----- Method: TextComposer>>composeOneLine (in category 'private') ----- - ----- Method: TextComposer>>composeOneLine (in category 'as yet unclassified') ----- composeOneLine | rectangles | rectangles := theContainer rectanglesAt: currentY height: defaultLineHeight. rectangles notEmpty ifTrue: [(self composeAllRectangles: rectangles) ifNil: [^nil]] ifFalse: [currentY := currentY + defaultLineHeight]. self checkIfReadyToSlide! Item was changed: + ----- Method: TextComposer>>slideOneLineDown (in category 'private') ----- - ----- Method: TextComposer>>slideOneLineDown (in category 'as yet unclassified') ----- slideOneLineDown | priorLine | "Having detected the end of rippling recoposition, we are only sliding old lines" prevIndex < prevLines size ifFalse: [ "There are no more prevLines to slide." ^nowSliding := possibleSlide := false ]. "Adjust and re-use previously composed line" prevIndex := prevIndex + 1. priorLine := (prevLines at: prevIndex) slideIndexBy: deltaCharIndex andMoveTopTo: currentY. lines addLast: priorLine. currentY := priorLine bottom. currCharIndex := priorLine last + 1. wantsColumnBreaks ifTrue: [ priorLine first to: priorLine last do: [ :i | (theText at: i) = Character characterForColumnBreak ifTrue: [ nowSliding := possibleSlide := false. ^nil ]. ]. ]. !

1 0

The Trunk: Files-nice.170.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-nice.170.mcz ==================== Summary ==================== Name: Files-nice.170 Author: nice Time: 26 April 2017, 11:01:48.184504 pm UUID: 16f1903f-4a56-4f35-b737-dbb16a9022ae Ancestors: Files-ul.169 Classify a few 'as yet unclassified' methods =============== Diff against Files-ul.169 =============== Item was changed: + ----- Method: DosFileDirectory>>checkName:fixErrors: (in category 'file name utilities') ----- - ----- Method: DosFileDirectory>>checkName:fixErrors: (in category 'as yet unclassified') ----- checkName: aFileName fixErrors: fixing "Check if the file name contains any invalid characters" | fName badChars hasBadChars | fName := super checkName: aFileName fixErrors: fixing. badChars := #( $: $< $> $| $/ $\ $? $* $") asSet. hasBadChars := fName includesAnyOf: badChars. (hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name']. hasBadChars ifFalse:[^ fName]. ^ fName collect: [:char | (badChars includes: char) ifTrue:[$#] ifFalse:[char]]! Item was changed: + ----- Method: DosFileDirectory>>setPathName: (in category 'private') ----- - ----- Method: DosFileDirectory>>setPathName: (in category 'as yet unclassified') ----- setPathName: pathString "Ensure pathString is absolute - relative directories aren't supported on all platforms." (pathString isEmpty or: [pathString first = $\ or: [pathString size >= 2 and: [pathString second = $: and: [pathString first isLetter]]]]) ifTrue: [^ super setPathName: pathString]. self error: 'Fully qualified path expected'! Item was changed: + ----- Method: InvalidDirectoryError>>defaultAction (in category 'handling') ----- - ----- Method: InvalidDirectoryError>>defaultAction (in category 'exceptionDescription') ----- defaultAction "Return an empty list as the default action of signaling the occurance of an invalid directory." ^#()! Item was changed: + ----- Method: MacFileDirectory>>fullNameFor: (in category 'file name utilities') ----- - ----- Method: MacFileDirectory>>fullNameFor: (in category 'as yet unclassified') ----- fullNameFor: fileName "Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name." "Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm. Also note that this method is tolerent of a nil argument -- is simply returns nil in this case." "Fix by hmm: for a file in the root directory of a volume on MacOS, the filePath (name of the directory) is not recognizable as an absolute path anymore (it has no delimiters). Therefore, the original fileName is tested for absoluteness, and the filePath is only made absolute if the original fileName was not absolute" | correctedLocalName prefix | fileName isEmptyOrNil ifTrue: [^ fileName]. DirectoryClass splitName: fileName to: [:filePath :localName | correctedLocalName := localName isEmpty ifFalse: [self checkName: localName fixErrors: true] ifTrue: [localName]. prefix := (DirectoryClass isAbsolute: fileName) ifTrue: [filePath] ifFalse: [self fullPathFor: filePath]]. prefix isEmpty ifTrue: [^correctedLocalName]. prefix last = self pathNameDelimiter ifTrue:[^ prefix, correctedLocalName] ifFalse:[^ prefix, self slash, correctedLocalName]!

1 0

The Trunk: Collections-nice.752.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.752.mcz ==================== Summary ==================== Name: Collections-nice.752 Author: nice Time: 26 April 2017, 10:54:03.973466 pm UUID: d3620c7a-7ead-43fb-93ee-21dce320c7eb Ancestors: Collections-ul.751 Classify a few 'as yet unclassified' methods =============== Diff against Collections-ul.751 =============== Item was changed: + ----- Method: EndOfStream>>defaultAction (in category 'handling') ----- - ----- Method: EndOfStream>>defaultAction (in category 'exceptionDescription') ----- defaultAction "Answer ReadStream>>next default reply." ^ nil! Item was changed: + ----- Method: LimitedWriteStream>>nextPutAll: (in category 'writing') ----- - ----- Method: LimitedWriteStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aCollection | newEnd | collection class == aCollection class ifFalse: [^ super nextPutAll: aCollection ]. newEnd := position + aCollection size. newEnd > limit ifTrue: [ super nextPutAll: (aCollection copyFrom: 1 to: (limit - position max: 0)). limitBlock value. ^aCollection ]. newEnd > writeLimit ifTrue: [ self growTo: newEnd + 10 ]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ^aCollection! Item was changed: + ----- Method: LimitedWriteStream>>pastEndPut: (in category 'private') ----- - ----- Method: LimitedWriteStream>>pastEndPut: (in category 'as yet unclassified') ----- pastEndPut: anObject collection size >= limit ifTrue: [limitBlock value]. "Exceptional return" ^ super pastEndPut: anObject! Item was changed: + ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'initialize-release') ----- - ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'as yet unclassified') ----- setLimit: sizeLimit limitBlock: aBlock "Limit the numer of elements this stream will write..." limit := sizeLimit. "Execute this (typically ^ contents) when that limit is exceded" limitBlock := aBlock! Item was changed: + ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'fileIn/fileOut') ----- - ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: aStream "Impossible for this kind of attribute" ^ self shouldNotImplement ! Item was changed: + ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'properties-setting') ----- - ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'as yet unclassified') ----- setFileTypeToObject "do nothing. We don't have a file type"! Item was changed: + ----- Method: TextAction>>analyze: (in category 'initialize-release') ----- - ----- Method: TextAction>>analyze: (in category 'as yet unclassified') ----- analyze: aString "Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection). Does not return self!!. May be multiline or of the form: 3+4 <3+4> Click Here<3+4> <3+4>Click Here " "Obtain the showing text and the instructions" | b1 b2 singleLine trim param show | b1 := aString indexOf: $<. b2 := aString indexOf: $>. singleLine := aString lineCount = 0. (singleLine or: [(b1 < b2) & (b1 > 0)]) ifFalse: ["only one part" param := self validate: aString. param ifNil: [ ^{ nil. nil } ]. ^ Array with: param with: (param size = 0 ifFalse: [param])]. "Two parts" trim := aString withBlanksTrimmed. (trim at: 1) == $< ifTrue: [(trim last) == $> ifTrue: ["only instructions" param := self validate: (aString copyFrom: b1+1 to: b2-1). show := param size = 0 ifFalse: [param]] ifFalse: ["at the front" param := self validate: (aString copyFrom: b1+1 to: b2-1). show := param size = 0 ifFalse: [aString copyFrom: b2+1 to: aString size]]] ifFalse: [(trim last) == $> ifTrue: ["at the end" param := self validate: (aString copyFrom: b1+1 to: b2-1). show := param size = 0 ifFalse: [aString copyFrom: 1 to: b1-1]] ifFalse: ["Arbitrary string. Let the compiler handle the complete string" param := self validate: aString. param ifNil: [ ^{ nil. nil }]. show := (param size = 0 ifFalse: [param])]]. ^ Array with: param with: show ! Item was changed: + ----- Method: TextAction>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAction>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasis for text display" Purple ifNil: [Purple := self userInterfaceTheme color ifNil: [Color r: 0.4 g: 0.0 b: 1]]. scanner textColor: Purple.! Item was changed: + ----- Method: TextAction>>info (in category 'accessing') ----- - ----- Method: TextAction>>info (in category 'as yet unclassified') ----- info ^ 'no hidden info'! Item was changed: + ----- Method: TextAction>>validate: (in category 'initialize-release') ----- - ----- Method: TextAction>>validate: (in category 'as yet unclassified') ----- validate: aString "any format is OK with me" ^ aString! Item was changed: + ----- Method: TextAlignment>>dominates: (in category 'testing') ----- - ----- Method: TextAlignment>>dominates: (in category 'as yet unclassified') ----- dominates: other "There can be only one..." ^self class == other class! Item was changed: + ----- Method: TextAlignment>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAlignment>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner setAlignment: alignment.! Item was changed: + ----- Method: TextAlignment>>shouldFormBlocks (in category 'testing') ----- - ----- Method: TextAlignment>>shouldFormBlocks (in category 'as yet unclassified') ----- shouldFormBlocks ^ true! Item was changed: + ----- Method: TextAttribute>>anchoredMorph (in category 'accessing') ----- - ----- Method: TextAttribute>>anchoredMorph (in category 'as yet unclassified') ----- anchoredMorph "If one hides here, return it" ^nil! Item was changed: + ----- Method: TextAttribute>>dominates: (in category 'testing') ----- - ----- Method: TextAttribute>>dominates: (in category 'as yet unclassified') ----- dominates: another "Subclasses may override condense multiple attributes" ^ false! Item was changed: + ----- Method: TextAttribute>>emphasisCode (in category 'accessing') ----- - ----- Method: TextAttribute>>emphasisCode (in category 'as yet unclassified') ----- emphasisCode "Subclasses may override to add bold, italic, etc" ^ 0! Item was changed: + ----- Method: TextAttribute>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAttribute>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Subclasses may override to set, eg, font, color, etc"! Item was changed: + ----- Method: TextAttribute>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextAttribute>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock "No action is the default. Overridden by font specs"! Item was changed: + ----- Method: TextAttribute>>mayActOnClick (in category 'testing') ----- - ----- Method: TextAttribute>>mayActOnClick (in category 'as yet unclassified') ----- mayActOnClick "Subclasses may override to provide, eg, hot-spot actions" ^ false! Item was changed: + ----- Method: TextAttribute>>mayBeExtended (in category 'testing') ----- - ----- Method: TextAttribute>>mayBeExtended (in category 'as yet unclassified') ----- mayBeExtended "A quality that may be overridden by subclasses, such as TextAnchors, that really only apply to a single character" ^ true! Item was changed: + ----- Method: TextAttribute>>menu (in category 'accessing') ----- - ----- Method: TextAttribute>>menu (in category 'as yet unclassified') ----- menu ^nil! Item was changed: + ----- Method: TextAttribute>>oldEmphasisCode: (in category 'accessing') ----- - ----- Method: TextAttribute>>oldEmphasisCode: (in category 'as yet unclassified') ----- oldEmphasisCode: default "Allows running thorugh possibly multiple attributes and getting the emphasis out of any that has an emphasis (font number)" ^ default! Item was changed: + ----- Method: TextAttribute>>reset (in category 'initialize-release') ----- - ----- Method: TextAttribute>>reset (in category 'as yet unclassified') ----- reset "Allow subclasses to prepare themselves for merging attributes"! Item was changed: + ----- Method: TextAttribute>>set (in category 'accessing') ----- - ----- Method: TextAttribute>>set (in category 'as yet unclassified') ----- set "Respond true to include this attribute (as opposed to, eg, a bold emphasizer that is clearing the property" ^ true! Item was changed: + ----- Method: TextDoIt>>actOnClickFor: (in category 'event handling') ----- - ----- Method: TextDoIt>>actOnClickFor: (in category 'as yet unclassified') ----- actOnClickFor: anObject "Note: evalString gets evaluated IN THE CONTEXT OF anObject -- meaning that self and all instVars are accessible" Compiler evaluate: evalString for: anObject. ^ true ! Item was changed: + ----- Method: TextDoIt>>analyze: (in category 'initialize-release') ----- - ----- Method: TextDoIt>>analyze: (in category 'as yet unclassified') ----- analyze: aString | list | list := super analyze: aString. evalString := (list at: 1) asString. ^ list at: 2! Item was changed: + ----- Method: TextDoIt>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextDoIt>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner scanner addEmphasis: 4! Item was changed: + ----- Method: TextDoIt>>info (in category 'accessing') ----- - ----- Method: TextDoIt>>info (in category 'as yet unclassified') ----- info ^ evalString! Item was changed: + ----- Method: TextEmphasis>>dominates: (in category 'testing') ----- - ----- Method: TextEmphasis>>dominates: (in category 'as yet unclassified') ----- dominates: other (emphasisCode = 0 and: [other dominatedByCmd0]) ifTrue: [^ true]. ^ (other class == self class) and: [emphasisCode = other emphasisCode]! Item was changed: + ----- Method: TextEmphasis>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextEmphasis>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner addEmphasis: emphasisCode! Item was changed: + ----- Method: TextFontChange>>dominates: (in category 'testing') ----- - ----- Method: TextFontChange>>dominates: (in category 'as yet unclassified') ----- dominates: other ^ other isKindOf: TextFontChange! Item was changed: + ----- Method: TextFontChange>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextFontChange>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the font for text display" scanner setFont: fontNumber! Item was changed: + ----- Method: TextFontChange>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextFontChange>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock aBlock value: (aTextStyle fontAt: fontNumber)! Item was changed: + ----- Method: TextFontReference>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextFontReference>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock aBlock value: font! Item was changed: + ----- Method: TextIndent>>amount (in category 'accessing') ----- - ----- Method: TextIndent>>amount (in category 'access') ----- amount "number of tab spaces to indent by" ^amount! Item was changed: + ----- Method: TextIndent>>amount: (in category 'accessing') ----- - ----- Method: TextIndent>>amount: (in category 'access') ----- amount: anInteger "change the number of tabs to indent by" amount := anInteger! Item was changed: + ----- Method: TextIndent>>shouldFormBlocks (in category 'testing') ----- - ----- Method: TextIndent>>shouldFormBlocks (in category 'nil') ----- shouldFormBlocks ^ true! Item was changed: + ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'private') ----- - ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'as yet unclassified') ----- applyAttribute: att beginningAt: startPos collection addAttribute: att from: startPos to: self position! Item was changed: + ----- Method: TextStream>>nextPutAll: (in category 'writing') ----- - ----- Method: TextStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aCollection "Optimized access to get around Text at:Put: overhead" | n | n := aCollection size. position + n > writeLimit ifTrue: [self growTo: position + n + 10]. collection replaceFrom: position+1 to: position + n with: aCollection startingAt: 1. position := position + n. ^aCollection! Item was changed: + ----- Method: TextStream>>withAttribute:do: (in category 'private') ----- - ----- Method: TextStream>>withAttribute:do: (in category 'as yet unclassified') ----- withAttribute: att do: strmBlock | pos1 val | pos1 := self position. val := strmBlock value. collection addAttribute: att from: pos1+1 to: self position. ^ val! Item was changed: + ----- Method: TextStream>>withAttributes:do: (in category 'private') ----- - ----- Method: TextStream>>withAttributes:do: (in category 'as yet unclassified') ----- withAttributes: attributes do: streamBlock | pos1 val | pos1 := self position. val := streamBlock value. attributes do: [:attribute | collection addAttribute: attribute from: pos1 + 1 to: self position]. ^ val! Item was changed: + ----- Method: TextURL>>analyze: (in category 'initialize-release') ----- - ----- Method: TextURL>>analyze: (in category 'as yet unclassified') ----- analyze: aString | list | list := super analyze: aString. (UIManager default request: 'URL to open' translated initialAnswer: (list at: 1)) in: [:answer | answer ifEmpty: [url := list at: 1] ifNotEmpty: [url := answer]]. ^ list at: 2! Item was changed: + ----- Method: TranscriptStream>>characterLimit (in category 'accessing') ----- - ----- Method: TranscriptStream>>characterLimit (in category 'access') ----- characterLimit "Tell the views how much to retain on screen" ^ 20000! Item was changed: + ----- Method: WordArrayForSegment>>restoreEndianness (in category 'objects from disk') ----- - ----- Method: WordArrayForSegment>>restoreEndianness (in category 'as yet unclassified') ----- restoreEndianness "This word object was just read in from a stream. Do not correct the Endianness because the load primitive will reverse bytes as needed." "^ self" ! Item was changed: + ----- Method: WordArrayForSegment>>writeOn: (in category 'objects from disk') ----- - ----- Method: WordArrayForSegment>>writeOn: (in category 'as yet unclassified') ----- writeOn: aByteStream "Write quickly and disregard the endianness of the words. Store the array of bits onto the argument, aStream. (leading byte ~= 16r80) identifies this as raw bits (uncompressed)." aByteStream nextInt32Put: self size. "4 bytes" aByteStream nextPutAll: self !

1 0

The Trunk: Compression-nice.53.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Compression to project The Trunk: http://source.squeak.org/trunk/Compression-nice.53.mcz ==================== Summary ==================== Name: Compression-nice.53 Author: nice Time: 26 April 2017, 10:52:24.507244 pm UUID: e6d7cbdf-497f-42b3-8b4b-f18c1f62409f Ancestors: Compression-nice.52 Classify a few 'as yet unclassified' methods =============== Diff against Compression-nice.52 =============== Item was changed: + ----- Method: GZipSurrogateStream>>ascii (in category 'accessing') ----- - ----- Method: GZipSurrogateStream>>ascii (in category 'as yet unclassified') ----- ascii self bufferStream ascii! Item was changed: + ----- Method: GZipSurrogateStream>>binary (in category 'accessing') ----- - ----- Method: GZipSurrogateStream>>binary (in category 'as yet unclassified') ----- binary self bufferStream binary! Item was changed: + ----- Method: GZipSurrogateStream>>bufferStream (in category 'private') ----- - ----- Method: GZipSurrogateStream>>bufferStream (in category 'as yet unclassified') ----- bufferStream ^bufferStream ifNil: [bufferStream := RWBinaryOrTextStream on: (ByteArray new: 5000)]. ! Item was changed: + ----- Method: GZipSurrogateStream>>close (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>close (in category 'as yet unclassified') ----- close "we don't want to until user is really done" ! Item was changed: + ----- Method: GZipSurrogateStream>>closed (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>closed (in category 'as yet unclassified') ----- closed ^false! Item was changed: + ----- Method: GZipSurrogateStream>>command: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>command: (in category 'as yet unclassified') ----- command: aString "Overridden by HtmlFileStream to append commands directly without translation. 4/5/96 tk" "We ignore any HTML commands. Do nothing"! Item was changed: + ----- Method: GZipSurrogateStream>>cr (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>cr (in category 'as yet unclassified') ----- cr self bufferStream cr! Item was changed: + ----- Method: GZipSurrogateStream>>fileOutClass:andObject: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>fileOutClass:andObject: (in category 'as yet unclassified') ----- fileOutClass: extraClass andObject: theObject "Write a file that has both the source code for the named class and an object as bits. Any instance-specific object will get its class written automatically." | class srefStream | self timeStamp. extraClass ifNotNil: [ class := extraClass. "A specific class the user wants written" class sharedPools size > 0 ifTrue: [ class shouldFileOutPools ifTrue: [class fileOutSharedPoolsOn: self] ]. class fileOutOn: self moveSource: false toFile: 0 ]. "Append the object's raw data" srefStream := SmartRefStream on: self. srefStream nextPut: theObject. "and all subobjects" srefStream close. "also closes me - well it thinks it does, anyway" ! Item was changed: + ----- Method: GZipSurrogateStream>>flushBuffer (in category 'private') ----- - ----- Method: GZipSurrogateStream>>flushBuffer (in category 'as yet unclassified') ----- flushBuffer | data | bufferStream ifNil: [^self]. data := bufferStream contents asByteArray. gZipStream nextPutAll: data. positionThusFar := positionThusFar + data size. bufferStream := nil. ! Item was changed: + ----- Method: GZipSurrogateStream>>header (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>header (in category 'as yet unclassified') ----- header "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>newFileNamed:inDirectory: (in category 'private') ----- - ----- Method: GZipSurrogateStream>>newFileNamed:inDirectory: (in category 'as yet unclassified') ----- newFileNamed: fName inDirectory: aDirectory positionThusFar := 0. zippedFileStream := aDirectory newFileNamed: fName. zippedFileStream binary; setFileTypeToObject. "Type and Creator not to be text, so can be enclosed in an email" gZipStream := GZipWriteStream on: zippedFileStream. ! Item was changed: + ----- Method: GZipSurrogateStream>>next (in category 'reading') ----- - ----- Method: GZipSurrogateStream>>next (in category 'as yet unclassified') ----- next ^self bufferStream next! Item was changed: + ----- Method: GZipSurrogateStream>>nextChunkPut: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextChunkPut: (in category 'as yet unclassified') ----- nextChunkPut: aString self bufferStream nextChunkPut: aString! Item was changed: + ----- Method: GZipSurrogateStream>>nextInt32Put: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextInt32Put: (in category 'as yet unclassified') ----- nextInt32Put: int32 ^self bufferStream nextInt32Put: int32 ! Item was changed: + ----- Method: GZipSurrogateStream>>nextNumber:put: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextNumber:put: (in category 'as yet unclassified') ----- nextNumber: n put: v ^self bufferStream nextNumber: n put: v ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPut: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPut: (in category 'as yet unclassified') ----- nextPut: aByte ^self bufferStream nextPut: aByte ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPutAll: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aString ^aString writeOnGZIPByteStream: self ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPutAllBytes: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPutAllBytes: (in category 'as yet unclassified') ----- nextPutAllBytes: aString ^self bufferStream nextPutAll: aString ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPutAllWordArray: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPutAllWordArray: (in category 'as yet unclassified') ----- nextPutAllWordArray: aWordArray | ba hackwa hackba blt rowsAtATime sourceOrigin rowsRemaining | self flag: #bob. "do we need to be concerned by bytesPerElement??" ba := nil. rowsAtATime := 2000. "or 8000 bytes" hackwa := Form new hackBits: aWordArray. sourceOrigin := 0@0. [(rowsRemaining := hackwa height - sourceOrigin y) > 0] whileTrue: [ rowsAtATime := rowsAtATime min: rowsRemaining. (ba isNil or: [ba size ~= (rowsAtATime * 4)]) ifTrue: [ ba := ByteArray new: rowsAtATime * 4. hackba := Form new hackBits: ba. blt := (BitBlt toForm: hackba) sourceForm: hackwa. ]. blt combinationRule: Form over; sourceOrigin: sourceOrigin; destX: 0 destY: 0 width: 4 height: rowsAtATime; copyBits. self bufferStream nextPutAll: ba. self flushBuffer. sourceOrigin := sourceOrigin x @ (sourceOrigin y + rowsAtATime). ]. ! Item was changed: + ----- Method: GZipSurrogateStream>>nextStringPut: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextStringPut: (in category 'as yet unclassified') ----- nextStringPut: s "Append the string, s, to the receiver. Only used by DataStream. Max size of 64*256*256*256." | length | (length := s size) < 192 ifTrue: [self nextPut: length] ifFalse: [self nextPut: (length digitAt: 4)+192. self nextPut: (length digitAt: 3). self nextPut: (length digitAt: 2). self nextPut: (length digitAt: 1)]. self nextPutAll: s. ^s! Item was changed: + ----- Method: GZipSurrogateStream>>nextWordsPutAll: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextWordsPutAll: (in category 'as yet unclassified') ----- nextWordsPutAll: aCollection "Write the argument a word-like object in big endian format on the receiver. May be used to write other than plain word-like objects (such as ColorArray)." ^self nextPutAllWordArray: aCollection! Item was changed: + ----- Method: GZipSurrogateStream>>originalContents (in category 'reading') ----- - ----- Method: GZipSurrogateStream>>originalContents (in category 'as yet unclassified') ----- originalContents ^'' "used only to determine if we are byte-structured"! Item was changed: + ----- Method: GZipSurrogateStream>>padToEndWith: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>padToEndWith: (in category 'as yet unclassified') ----- padToEndWith: aChar "We don't have pages, so we are at the end, and don't need to pad."! Item was changed: + ----- Method: GZipSurrogateStream>>position (in category 'positionning') ----- - ----- Method: GZipSurrogateStream>>position (in category 'as yet unclassified') ----- position ^self bufferStream position + positionThusFar! Item was changed: + ----- Method: GZipSurrogateStream>>reallyClose (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>reallyClose (in category 'as yet unclassified') ----- reallyClose self flushBuffer. gZipStream close. ! Item was changed: + ----- Method: GZipSurrogateStream>>reopen (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>reopen (in category 'as yet unclassified') ----- reopen "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>setFileTypeToObject (in category 'properties-setting') ----- - ----- Method: GZipSurrogateStream>>setFileTypeToObject (in category 'as yet unclassified') ----- setFileTypeToObject "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>setToEnd (in category 'positionning') ----- - ----- Method: GZipSurrogateStream>>setToEnd (in category 'as yet unclassified') ----- setToEnd "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>skip: (in category 'positionning') ----- - ----- Method: GZipSurrogateStream>>skip: (in category 'as yet unclassified') ----- skip: aNumber ^self bufferStream skip: aNumber ! Item was changed: + ----- Method: GZipSurrogateStream>>timeStamp (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>timeStamp (in category 'as yet unclassified') ----- timeStamp "Append the current time to the receiver as a String." self bufferStream nextChunkPut: "double string quotes and !!s" (String streamContents: [:s | Smalltalk timeStamp: s]) printString. self bufferStream cr! Item was changed: + ----- Method: GZipSurrogateStream>>trailer (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>trailer (in category 'as yet unclassified') ----- trailer "ignore"!

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
23
Older →

Jump to page: