Squeak-dev October 2013

squeak-dev@lists.squeakfoundation.org

35 participants
262 discussions

The Trunk: Graphics-nice.250.mcz
by commits＠source.squeak.org 05 Oct '13

05 Oct '13

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.250.mcz ==================== Summary ==================== Name: Graphics-nice.250 Author: nice Time: 5 October 2013, 12:51:56.389 am UUID: 792cd68c-1112-4b21-81aa-a263b503fd23 Ancestors: Graphics-nice.249 Categorize placeEmbeddedObject: as private Merge Graphics-Text support and Graphics-Text: really, these are all support classes Remove TextLine>>justifiedPadFor: which is superseded by justifiedPadFor:font: for a few years now (since integration of FreeType support in trunk image). =============== Diff against Graphics-nice.249 =============== Item was changed: SystemOrganization addCategory: #'Graphics-Display Objects'! SystemOrganization addCategory: #'Graphics-External-Ffenestri'! SystemOrganization addCategory: #'Graphics-Files'! SystemOrganization addCategory: #'Graphics-Fonts'! SystemOrganization addCategory: #'Graphics-Primitives'! SystemOrganization addCategory: #'Graphics-Text'! SystemOrganization addCategory: #'Graphics-Transformations'! - SystemOrganization addCategory: #'Graphics-Text Support'! Item was changed: + ----- Method: CharacterBlockScanner>>placeEmbeddedObject: (in category 'private') ----- - ----- Method: CharacterBlockScanner>>placeEmbeddedObject: (in category 'stop conditions') ----- placeEmbeddedObject: anchoredMorph "Workaround: The following should really use #textAnchorType" anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. (super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false]. specialWidth := anchoredMorph width. ^ true! Item was changed: + ----- Method: CharacterScanner>>placeEmbeddedObject: (in category 'private') ----- - ----- Method: CharacterScanner>>placeEmbeddedObject: (in category 'text attributes') ----- placeEmbeddedObject: anchoredMorph "Place the anchoredMorph or return false if it cannot be placed. In any event, advance destX by its width." | w | "Workaround: The following should really use #textAnchorType" anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. destX := destX + (w := anchoredMorph width). (destX > rightMargin and: [(leftMargin + w) <= rightMargin]) ifTrue: ["Won't fit, but would on next line" ^ false]. lastIndex := lastIndex + 1. "self setFont." "Force recalculation of emphasis for next run" ^ true! Item was changed: + ----- Method: CompositionScanner>>placeEmbeddedObject: (in category 'private') ----- - ----- Method: CompositionScanner>>placeEmbeddedObject: (in category 'stop conditions') ----- placeEmbeddedObject: anchoredMorph | descent | "Workaround: The following should really use #textAnchorType" anchoredMorph relativeTextAnchorPosition ifNotNil:[^true]. (super placeEmbeddedObject: anchoredMorph) ifFalse: ["It doesn't fit" "But if it's the first character then leave it here" lastIndex < line first ifFalse:[ line stop: lastIndex-1. ^ false]]. descent := lineHeight - baseline. lineHeight := lineHeight max: anchoredMorph height. baseline := lineHeight - descent. line stop: lastIndex. ^ true! Item was changed: + ----- Method: DisplayScanner>>placeEmbeddedObject: (in category 'private') ----- - ----- Method: DisplayScanner>>placeEmbeddedObject: (in category 'stop conditions') ----- placeEmbeddedObject: anchoredMorph anchoredMorph relativeTextAnchorPosition ifNotNil:[ anchoredMorph position: anchoredMorph relativeTextAnchorPosition + (anchoredMorph owner textBounds origin x @ 0) - (0@morphicOffset y) + (0@lineY). ^true ]. (super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false]. (anchoredMorph isMorph or: [anchoredMorph isPrimitiveCostume]) ifTrue: [ anchoredMorph position: ((destX - anchoredMorph width)@lineY) - morphicOffset ] ifFalse: [ destY := lineY. runX := destX. anchoredMorph displayOn: bitBlt destForm at: destX - anchoredMorph width @ destY clippingBox: bitBlt clipRect ]. ^ true! Item was changed: Object subclass: #TextComposer instanceVariableNames: 'lines maxRightX currentY scanner possibleSlide nowSliding prevIndex prevLines currCharIndex startCharIndex stopCharIndex deltaCharIndex theText theContainer isFirstLine theTextStyle defaultLineHeight actualHeight wantsColumnBreaks' classVariableNames: '' poolDictionaries: '' + category: 'Graphics-Text'! - category: 'Graphics-Text Support'! Item was changed: Object subclass: #TextLine instanceVariableNames: 'left right top bottom firstIndex lastIndex internalSpaces paddingWidth baseline leftMargin' classVariableNames: '' poolDictionaries: 'TextConstants' + category: 'Graphics-Text'! - category: 'Graphics-Text Support'! !TextLine commentStamp: '<historical>' prior: 0! A TextLine embodies the layout of a line of composed text. left right top bottom The full line rectangle firstIndex lastIndex Starting and stopping indices in the full text internalSpaces Number of spaces to share paddingWidth paddingWidth Number of pixels of extra space in full line baseline Distance of baseline below the top of the line leftMargin Left margin due to paragraph indentation TextLine's rather verbose message protocol is required for compatibility with the old CharacterScanners.! Item was removed: - ----- Method: TextLine>>justifiedPadFor: (in category 'scanning') ----- - justifiedPadFor: spaceIndex - "Compute the width of pad for a given space in a line of justified text." - - | pad | - internalSpaces = 0 ifTrue: [^0]. - pad := paddingWidth // internalSpaces. - spaceIndex <= (paddingWidth \\ internalSpaces) - ifTrue: [^pad + 1] - ifFalse: [^pad]!

1 0

Suspicious TextAnchor emphasizeScanner:
by Nicolas Cellier 05 Oct '13

05 Oct '13

>From Bob's history site (http://69.251.218.6:9116/diffs) we can see this : emphasizeScanner: --squeak 1.31-- emphasizeScanner: scanner scanner placeEmbeddedObject: anchoredMorph 4614TextAndFonts-ar.cs emphasizeScanner: scanner scanner placeEmbeddedObject: anchoredMorph "Do nothing for emphasizing the scanner - if the anchor is valid a #embeddedObject will be encountered by the scanner and do the real thing" Indeed, a TextAnchor is associated with character of asciiValue 1, and there is a DefaultStopCondition for that which will invoke #embeddedObject stopCondition... But current implementation is back to old implementation !TextAnchor methodsFor: 'visiting' stamp: 'lr 2/3/2006 16:13'! emphasizeScanner: aScanner self anchoredMorph ifNil: [ ^ self ]. aScanner placeEmbeddedObject: self anchoredMorph. This has wrong consequences when the embedded morph crosses the right margin... It is then not displayed at the right place (too far right on the next line), presumably because indentation would occur twice but logic is really hard to follow... So I suggest reverting... Any hint on this?

2 2

The Trunk: Morphic-nice.695.mcz
by commits＠source.squeak.org 05 Oct '13

05 Oct '13

Nicolas Cellier uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-nice.695.mcz ==================== Summary ==================== Name: Morphic-nice.695 Author: nice Time: 5 October 2013, 12:05:58.658 am UUID: c0320b47-c05e-4f35-ae13-9faee7640629 Ancestors: Morphic-nice.694 A TextAnchor should not try to directly #placeEmbeddedObject: when emphasizing the scanner. Indeed, a scanner requests the Text to apply emphasis/attributes at an initialization stage (setFont). It is the scanner scan loop which is responsible for composing the text. Since this initialization happens outside the scan loop, the scanner is not yet ready to place anything. The placement will happen later when the scanner is willing to, by the following mechanism: - every TextAnchor is associated with a (Character value: 1). - there is a stopCondition associated to this value which will be processed in the scan loop and invoke #embeddedObject. - #embeddedObject will send #placeEmbeddedObject: Restoring this method from 12 years ago fixes a glitch when the embedded morph crosses the right margin. The glitch is due to a setFont which is sent from inside the scan loop in some conditions and incorrectly increments twice the morph display position. =============== Diff against Morphic-nice.694 =============== Item was changed: ----- Method: TextAnchor>>emphasizeScanner: (in category 'visiting') ----- + emphasizeScanner: scanner + "Do nothing for emphasizing the scanner - if the anchor is valid a #embeddedObject will be encountered by the scanner and do the real thing"! - emphasizeScanner: aScanner - self anchoredMorph ifNil: [ ^ self ]. - aScanner placeEmbeddedObject: self anchoredMorph.!

1 0

The Trunk: Graphics-nice.249.mcz
by commits＠source.squeak.org 04 Oct '13

04 Oct '13

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.249.mcz ==================== Summary ==================== Name: Graphics-nice.249 Author: nice Time: 4 October 2013, 10:19:18.659 pm UUID: d13115d9-7d8d-4689-8114-d8d00741f7c0 Ancestors: Graphics-nice.248 Move TextLineInterval from Graphics to ST80-Support =============== Diff against Graphics-nice.248 =============== Item was removed: - Interval subclass: #TextLineInterval - instanceVariableNames: 'internalSpaces paddingWidth lineHeight baseline' - classVariableNames: '' - poolDictionaries: 'TextConstants' - category: 'Graphics-Text'! - - !TextLineInterval commentStamp: '<historical>' prior: 0! - My instances specify the starting and stopping points in a String of a composed line. The step is always 1.! Item was removed: - ----- Method: TextLineInterval class>>start:stop:internalSpaces:paddingWidth: (in category 'instance creation') ----- - start: startInteger stop: stopInteger internalSpaces: spacesInteger paddingWidth: padWidthInteger - "Answer an instance of me with the arguments as the start, stop points, - number of spaces in the line, and width of the padding." - | newSelf | - newSelf := super from: startInteger to: stopInteger by: 1. - ^newSelf internalSpaces: spacesInteger paddingWidth: padWidthInteger! Item was removed: - ----- Method: TextLineInterval>>= (in category 'comparing') ----- - = line - - self species = line species - ifTrue: [^((start = line first and: [stop = line last]) - and: [internalSpaces = line internalSpaces]) - and: [paddingWidth = line paddingWidth]] - ifFalse: [^false]! Item was removed: - ----- Method: TextLineInterval>>baseline (in category 'accessing') ----- - baseline - ^ baseline! Item was removed: - ----- Method: TextLineInterval>>internalSpaces (in category 'accessing') ----- - internalSpaces - "Answer the number of spaces in the line." - - ^internalSpaces! Item was removed: - ----- Method: TextLineInterval>>internalSpaces: (in category 'accessing') ----- - internalSpaces: spacesInteger - "Set the number of spaces in the line to be spacesInteger." - - internalSpaces := spacesInteger! Item was removed: - ----- Method: TextLineInterval>>internalSpaces:paddingWidth: (in category 'private') ----- - internalSpaces: spacesInteger paddingWidth: padWidthInteger - - internalSpaces := spacesInteger. - paddingWidth := padWidthInteger! Item was removed: - ----- Method: TextLineInterval>>justifiedPadFor: (in category 'scanning') ----- - justifiedPadFor: spaceIndex - "Compute the width of pad for a given space in a line of justified text." - - | pad | - internalSpaces = 0 ifTrue: [^0]. - pad := paddingWidth // internalSpaces. - spaceIndex <= (paddingWidth \\ internalSpaces) - ifTrue: [^pad + 1] - ifFalse: [^pad]! Item was removed: - ----- Method: TextLineInterval>>justifiedPadFor:font: (in category 'scanning') ----- - justifiedPadFor: spaceIndex font: aFont - "Compute the width of pad for a given space in a line of justified text." - - | pad | - internalSpaces = 0 ifTrue: [^0]. - ^(aFont notNil and:[aFont isSubPixelPositioned]) - ifTrue:[paddingWidth * 1.0 / internalSpaces] - ifFalse:[ - pad := paddingWidth // internalSpaces. - spaceIndex <= (paddingWidth \\ internalSpaces) - ifTrue: [pad + 1] - ifFalse: [pad]]! Item was removed: - ----- Method: TextLineInterval>>justifiedTabDeltaFor: (in category 'scanning') ----- - justifiedTabDeltaFor: spaceIndex - "Compute the delta for a tab in a line of justified text, so tab falls - somewhere plausible when line is justified." - - | pad extraPad | - internalSpaces = 0 ifTrue: [^0]. - pad := paddingWidth // internalSpaces. - extraPad := paddingWidth \\ internalSpaces. - spaceIndex <= extraPad - ifTrue: [^spaceIndex * (pad + 1)] - ifFalse: [^extraPad * (pad + 1) + (spaceIndex - extraPad * pad)]! Item was removed: - ----- Method: TextLineInterval>>lineHeight (in category 'accessing') ----- - lineHeight - ^ lineHeight! Item was removed: - ----- Method: TextLineInterval>>lineHeight:baseline: (in category 'private') ----- - lineHeight: height baseline: ascent - - lineHeight := height. - baseline := ascent! Item was removed: - ----- Method: TextLineInterval>>paddingWidth (in category 'accessing') ----- - paddingWidth - "Answer the amount of space to be added to the font." - - ^paddingWidth! Item was removed: - ----- Method: TextLineInterval>>paddingWidth: (in category 'accessing') ----- - paddingWidth: padWidthInteger - "Set the amount of space to be added to the font to be padWidthInteger." - - paddingWidth := padWidthInteger! Item was removed: - ----- Method: TextLineInterval>>slide: (in category 'updating') ----- - slide: delta - "Change the starting and stopping points of the line by delta." - - start := start + delta. - stop := stop + delta! Item was removed: - ----- Method: TextLineInterval>>stop: (in category 'accessing') ----- - stop: stopInteger - "Set the stopping point in the string of the line to be stopInteger." - - stop := stopInteger!

1 0

The Trunk: ST80-nice.154.mcz
by commits＠source.squeak.org 04 Oct '13

04 Oct '13

Nicolas Cellier uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-nice.154.mcz ==================== Summary ==================== Name: ST80-nice.154 Author: nice Time: 4 October 2013, 10:17:32.034 pm UUID: 4522e1f4-5ea4-41f9-b2bf-9cc06ab5a07a Ancestors: ST80-nice.153 Move TextLineInterval from Graphics to ST80-Support =============== Diff against ST80-nice.153 =============== Item was added: + Interval subclass: #TextLineInterval + instanceVariableNames: 'internalSpaces paddingWidth lineHeight baseline' + classVariableNames: '' + poolDictionaries: 'TextConstants' + category: 'ST80-Support'! + + !TextLineInterval commentStamp: '<historical>' prior: 0! + My instances specify the starting and stopping points in a String of a composed line. The step is always 1.! Item was added: + ----- Method: TextLineInterval class>>start:stop:internalSpaces:paddingWidth: (in category 'instance creation') ----- + start: startInteger stop: stopInteger internalSpaces: spacesInteger paddingWidth: padWidthInteger + "Answer an instance of me with the arguments as the start, stop points, + number of spaces in the line, and width of the padding." + | newSelf | + newSelf := super from: startInteger to: stopInteger by: 1. + ^newSelf internalSpaces: spacesInteger paddingWidth: padWidthInteger! Item was added: + ----- Method: TextLineInterval>>= (in category 'comparing') ----- + = line + + self species = line species + ifTrue: [^((start = line first and: [stop = line last]) + and: [internalSpaces = line internalSpaces]) + and: [paddingWidth = line paddingWidth]] + ifFalse: [^false]! Item was added: + ----- Method: TextLineInterval>>baseline (in category 'accessing') ----- + baseline + ^ baseline! Item was added: + ----- Method: TextLineInterval>>internalSpaces (in category 'accessing') ----- + internalSpaces + "Answer the number of spaces in the line." + + ^internalSpaces! Item was added: + ----- Method: TextLineInterval>>internalSpaces: (in category 'accessing') ----- + internalSpaces: spacesInteger + "Set the number of spaces in the line to be spacesInteger." + + internalSpaces := spacesInteger! Item was added: + ----- Method: TextLineInterval>>internalSpaces:paddingWidth: (in category 'private') ----- + internalSpaces: spacesInteger paddingWidth: padWidthInteger + + internalSpaces := spacesInteger. + paddingWidth := padWidthInteger! Item was added: + ----- Method: TextLineInterval>>justifiedPadFor: (in category 'scanning') ----- + justifiedPadFor: spaceIndex + "Compute the width of pad for a given space in a line of justified text." + + | pad | + internalSpaces = 0 ifTrue: [^0]. + pad := paddingWidth // internalSpaces. + spaceIndex <= (paddingWidth \\ internalSpaces) + ifTrue: [^pad + 1] + ifFalse: [^pad]! Item was added: + ----- Method: TextLineInterval>>justifiedPadFor:font: (in category 'scanning') ----- + justifiedPadFor: spaceIndex font: aFont + "Compute the width of pad for a given space in a line of justified text." + + | pad | + internalSpaces = 0 ifTrue: [^0]. + ^(aFont notNil and:[aFont isSubPixelPositioned]) + ifTrue:[paddingWidth * 1.0 / internalSpaces] + ifFalse:[ + pad := paddingWidth // internalSpaces. + spaceIndex <= (paddingWidth \\ internalSpaces) + ifTrue: [pad + 1] + ifFalse: [pad]]! Item was added: + ----- Method: TextLineInterval>>justifiedTabDeltaFor: (in category 'scanning') ----- + justifiedTabDeltaFor: spaceIndex + "Compute the delta for a tab in a line of justified text, so tab falls + somewhere plausible when line is justified." + + | pad extraPad | + internalSpaces = 0 ifTrue: [^0]. + pad := paddingWidth // internalSpaces. + extraPad := paddingWidth \\ internalSpaces. + spaceIndex <= extraPad + ifTrue: [^spaceIndex * (pad + 1)] + ifFalse: [^extraPad * (pad + 1) + (spaceIndex - extraPad * pad)]! Item was added: + ----- Method: TextLineInterval>>lineHeight (in category 'accessing') ----- + lineHeight + ^ lineHeight! Item was added: + ----- Method: TextLineInterval>>lineHeight:baseline: (in category 'private') ----- + lineHeight: height baseline: ascent + + lineHeight := height. + baseline := ascent! Item was added: + ----- Method: TextLineInterval>>paddingWidth (in category 'accessing') ----- + paddingWidth + "Answer the amount of space to be added to the font." + + ^paddingWidth! Item was added: + ----- Method: TextLineInterval>>paddingWidth: (in category 'accessing') ----- + paddingWidth: padWidthInteger + "Set the amount of space to be added to the font to be padWidthInteger." + + paddingWidth := padWidthInteger! Item was added: + ----- Method: TextLineInterval>>slide: (in category 'updating') ----- + slide: delta + "Change the starting and stopping points of the line by delta." + + start := start + delta. + stop := stop + delta! Item was added: + ----- Method: TextLineInterval>>stop: (in category 'accessing') ----- + stop: stopInteger + "Set the stopping point in the string of the line to be stopInteger." + + stop := stopInteger!

1 0

Re: [squeak-dev] The Trunk: Compiler-cmm.275.mcz
by Chris Muller 04 Oct '13

04 Oct '13

The reformatting caused almost all lines to be dif'd. The only change is handling AttemptToWriteReadOnlyGlobal on the at:put:. On Thu, Oct 3, 2013 at 2:35 PM, <commits(a)source.squeak.org> wrote: > Chris Muller uploaded a new version of Compiler to project The Trunk: > http://source.squeak.org/trunk/Compiler-cmm.275.mcz > > ==================== Summary ==================== > > Name: Compiler-cmm.275 > Author: cmm > Time: 3 October 2013, 2:34:56.409 pm > UUID: 9d002330-e75e-436f-8699-b29413e98e81 > Ancestors: Compiler-nice.274 > > When loading code, don't blow up just because of an undeclared ref. > > =============== Diff against Compiler-nice.274 =============== > > Item was changed: > ----- Method: Encoder>>undeclared: (in category 'encoding') ----- > + undeclared: name > - undeclared: name > | sym | > requestor interactive ifTrue: > + [ requestor requestor == #error: ifTrue: [ requestor error: 'Undeclared' ]. > + ^ self notify: 'Undeclared' ]. > - [requestor requestor == #error: ifTrue: > - [requestor error: 'Undeclared']. > - ^self notify: 'Undeclared']. > "Allow knowlegeable clients to squash the undeclared warning if they want (e.g. > Diffing pretty printers that are simply formatting text). As this breaks > compilation it should only be used by clients that want to discard the result > of the compilation. To squash the warning use e.g. > [Compiler format: code in: class notifying: nil decorated: false] > on: UndeclaredVariableWarning > do: [:ex| ex resume: false]" > sym := name asSymbol. > + ^ (UndeclaredVariableWarning new > + name: name > + selector: selector > + class: cue getClass) signal > - ^(UndeclaredVariableWarning new name: name selector: selector class: cue getClass) signal > ifTrue: > + [ | undeclared | > - [| undeclared | > undeclared := cue environment undeclared. > + [ undeclared > + at: sym > + put: nil ] > + on: AttemptToWriteReadOnlyGlobal > + do: [ : noti | noti resume: true ]. > + self > + global: (undeclared associationAt: sym) > + name: sym ] > - undeclared at: sym put: nil. > - self global: (undeclared associationAt: sym) name: sym] > ifFalse: > + [ self > + global: (Association key: sym) > + name: sym ]! > - [self global: (Association key: sym) name: sym]! > >

2 1

Re: [squeak-dev] The Trunk: System-cmm.600.mcz
by Frank Shearar 04 Oct '13

04 Oct '13

On 04 Oct 2013, at 8:37, commits(a)source.squeak.org wrote: > Chris Muller uploaded a new version of System to project The Trunk: > http://source.squeak.org/trunk/System-cmm.600.mcz > > ==================== Summary ==================== > > Name: System-cmm.600 > Author: cmm > Time: 3 October 2013, 2:49:50.903 pm > UUID: 1dc3ab37-822a-4ac0-93d0-c06542622247 > Ancestors: System-fbs.599 > > - RecentMessages can now temporarily suspend, so it'll be able to avoid being blown away just from loading MC packages. > - API consistency. > - Test methods moved to Tests. > > =============== Diff against System-fbs.599 =============== > > Item was changed: > Object subclass: #RecentMessages > + instanceVariableNames: 'methodReferences size maximumSubmissionCount isSuspended' > - instanceVariableNames: 'methodReferences size maximumSubmissionCount' > classVariableNames: 'Default NumberOfRecentSubmissionsToStore' > poolDictionaries: '' > category: 'System-Support'! > > Item was changed: > ----- Method: RecentMessages>>initialize (in category 'initialize-release') ----- > initialize > + self initializeWithSize: self defaultSize! > - maximumSubmissionCount := self defaultSize. > - methodReferences := OrderedCollection new.! > > Item was added: > + ----- Method: RecentMessages>>leastRecent (in category 'accessing') ----- > + leastRecent > + ^ methodReferences > + ifEmpty: [nil] > + ifNotEmpty: [methodReferences first].! > > Item was removed: > - ----- Method: RecentMessages>>oldest (in category 'accessing') ----- > - oldest > - ^ methodReferences > - ifEmpty: [nil] > - ifNotEmpty: [methodReferences first].! > > Item was removed: > - ----- Method: RecentMessages>>purge: (in category 'accessing') ----- > - purge: aMethodReference > - methodReferences remove: aMethodReference.! > > Item was removed: > - ----- Method: RecentMessages>>purgeMissingMethods (in category 'accessing') ----- > - purgeMissingMethods > - methodReferences := methodReferences select: [:mref | |cls| > - cls := mref actualClass. > - cls notNil > - and: [cls isInMemory] > - and: [mref selector == #Comment or: [(cls compiledMethodAt: mref selector ifAbsent: [nil]) notNil]]].! I don't understand why you've ripped out purging. You now allow RecentMessages to have MethodReferences that will blow up whenever you try to resolve them. I mean, the brokenness of #actualClass aside (*) why the removal? (*) #actualClass and friends make no sense in a multi-Environment world: what a class name means depends on the context nowadays. frank > Item was changed: > ----- Method: RecentMessages>>recordSelector:forClass:inEnvironment: (in category 'accessing') ----- > recordSelector: aSelector forClass: aClass inEnvironment: anEnvironment > | ref | > + isSuspended = true ifTrue: [ ^ self ]. > ref := MethodReference > class: aClass > selector: aSelector > environment: anEnvironment. > aClass wantsChangeSetLogging ifFalse: [^ ref]. > ^ methodReferences > detect: [:mref | mref = ref] > ifNone: [methodReferences addLast: ref. > self size > self maximumSubmissionCount > ifTrue: [methodReferences removeFirst]. > ref].! > > Item was added: > + ----- Method: RecentMessages>>suspendWhile: (in category 'accessing') ----- > + suspendWhile: aBlock > + | priorSuspended | > + priorSuspended := isSuspended. > + isSuspended := true. > + aBlock ensure: [ isSuspended := priorSuspended ]! > >

1 0

The Inbox: Monticello-cmm.575.mcz
by commits＠source.squeak.org 04 Oct '13

04 Oct '13

A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-cmm.575.mcz ==================== Summary ==================== Name: Monticello-cmm.575 Author: cmm Time: 3 October 2013, 9:42:40.555 pm UUID: daeb51c6-0b6f-41db-883d-e9764e61d8c5 Ancestors: Monticello-cmm.573 - Integrate Berts suggestions. Refactored and renamed the API for the new history and origin browsing functions to avoid ambiguity with other MC domain elements. Went from "version" nomenclature to "history". - Related to those functions, browsing a list of patch operations is now abstracted from browsing a Patch. MCPatch is now a MCOperationsList and, likewise, a MCPatchBrowser inherits from a MCOperationsBrowser. - Added well-known repository accessors for #trunk and #packageCache, and #trunkUrlString avoids scattering the hard-coded url string literal in so many places. =============== Diff against Monticello-cmm.573 =============== Item was added: + ----- Method: BrowserRequestor>>browseMcClassHistory (in category '*monticello-history') ----- + browseMcClassHistory + "Open a browser on all versions of this class available in the MC repository for this package." + self getClass + ifNil: [ UIManager inform: 'No class selected' ] + ifNotNilDo: + [ : theClass | theClass mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , theClass packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (MCOperationsList operations: theClass mcPatchOperations) browse ] ]! Item was added: + ----- Method: BrowserRequestor>>browseMcClassOrigin (in category '*monticello-history') ----- + browseMcClassOrigin + "Open a Monticello version browser on the earliest version available in the repository known to contain this version." + self getClass + ifNil: [ UIManager inform: 'No method selected' ] + ifNotNilDo: + [ : selectedClass | selectedClass mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , selectedClass packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (mcModel originOf: selectedClass asClassDefinition) + ifNil: [ UIManager inform: selectedClass asString , ' was not found in any Magma-based MC repository.' ] + ifNotNilDo: + [ : version | version open ] ] ]! Item was added: + ----- Method: BrowserRequestor>>browseMcMethodHistory (in category '*monticello-history') ----- + browseMcMethodHistory + "Open a browser on all versions of this method available in the MC repository for this package." + self selectedMethodReference + ifNil: [ UIManager inform: 'No method selected' ] + ifNotNilDo: + [ : methodReference | methodReference mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , methodReference packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (MCOperationsList operations: methodReference mcPatchOperations) browse ] ]! Item was added: + ----- Method: BrowserRequestor>>browseMcMethodOrigin (in category '*monticello-history') ----- + browseMcMethodOrigin + "Open a Monticello version browser on the earliest version available in the repository known to contain this version." + self selectedMethodReference + ifNil: [ UIManager inform: 'No method selected' ] + ifNotNilDo: + [ : methodReference | methodReference mcModel + ifNil: [ UIManager inform: 'No Magma-based repository for ' , methodReference packageInfo packageName ] + ifNotNilDo: + [ : mcModel | (mcModel originOf: methodReference asMethodDefinition) + ifNil: [ UIManager inform: methodReference asString , ' was not found in any Magma-based MC repository.' ] + ifNotNilDo: + [ : version | version open ] ] ]! Item was added: + ----- Method: BrowserRequestor>>canBrowseMcClassHistory (in category '*monticello-history') ----- + canBrowseMcClassHistory + ^ self getClass + ifNil: [ false ] + ifNotNilDo: + [ : class | class mcModel notNil ]! Item was added: + ----- Method: BrowserRequestor>>canBrowseMcMethodHistory (in category '*monticello-history') ----- + canBrowseMcMethodHistory + ^ self selectedMethodReference + ifNil: [ false ] + ifNotNilDo: + [ : methodReference | methodReference mcModel notNil ]! Item was added: + ----- Method: BrowserRequestor>>selectedMethodReference (in category '*monticello-history') ----- + selectedMethodReference + ^ MethodReference + class: self getClass + selector: self getSelector! Item was added: + ----- Method: Class>>mcHistory (in category '*monticello') ----- + mcHistory + "Answer a collection of MCClassDefinitions for this Class, which are in the first Magma-backed repository in the list of repositories of my working-copy." + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel historyOf: self asClassDefinition ]! Item was added: + ----- Method: Class>>mcModel (in category '*monticello') ----- + mcModel + ^ self asClassDefinition mcModel! Item was added: + ----- Method: Class>>mcOrigin (in category '*monticello') ----- + mcOrigin + "Answer the MCVersion in which this definition of this class was originally committed." + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel originOf: self ]! Item was added: + ----- Method: Class>>mcPatchOperations (in category '*monticello') ----- + mcPatchOperations + "Answer a collection of MCPatchOperations that can be displayed in a MCPatchBrowser which will reflect the history of this methods definition in relation to each other (not simply compared to the image version)." + ^(self mcHistory reversed + inject: OrderedCollection new + into: + [ : coll : each | coll + ifEmpty: + [ coll + add: (MCAddition of: each) ; + yourself ] + ifNotEmpty: + [ coll + add: + (MCModification + of: + (coll last isAddition + ifTrue: [ coll last definition ] + ifFalse: [ coll last modification ]) + to: each) ; + yourself ] ]) reversed! Item was added: + ----- Method: Class>>packageInfo (in category '*monticello') ----- + packageInfo + ^ PackageInfo allPackages + detect: [ : each | each includesClass: self ] + ifNone: [ nil ]! Item was removed: - ----- Method: MCCacheRepository class>>reduceTo: (in category 'utilities') ----- - reduceTo: numberOfBytesToKeepOnDisk - | newestToOldest | - newestToOldest := self default directory entries sort: - [ : a : b | a modificationDateAndTime > b modificationDateAndTime ]. - newestToOldest - inject: 0 - into: - [ : sum : each | each isDirectory ifFalse: - [ sum > numberOfBytesToKeepOnDisk ifTrue: [ each delete ]. - sum + each fileSize ] ]! Item was removed: - ----- Method: MCCacheRepository>>packageForFileNamed: (in category 'as yet unclassified') ----- - packageForFileNamed: aString - ^ self packageCache at: aString ifAbsentPut: [self versionReaderForFileNamed: aString do: [:r | r package]]! Item was changed: ----- Method: MCChangeSelectionRequest>>defaultAction (in category 'as yet unclassified') ----- defaultAction + ^ (MCChangeSelector forPatch: patch) + label: label ; + showModally! - ^ (MCChangeSelector new patch: patch; label: label) showModally! Item was added: + ----- Method: MCCodeTool>>items (in category 'accessing') ----- + items + ^ items! Item was added: + ----- Method: MCCodeTool>>setItems: (in category 'initialize-release') ----- + setItems: aCollection + items := aCollection! Item was added: + ----- Method: MCDefinition>>findMcModel (in category 'private') ----- + findMcModel + "Find my WorkingCopy, use the first mcModel-capable repository in its reposigoryGroup." + self repositoryGroup repositoriesDo: + [ : each | each mcModel ifNotNilDo: + [ : mcModel | ^ mcModel ] ]. + ^ nil! Item was added: + ----- Method: MCDefinition>>mcModel (in category 'private') ----- + mcModel + ^ self findMcModel ifNil: [ super mcModel ]! Item was added: + ----- Method: MCDefinition>>origin (in category 'private') ----- + origin + "Answer the MCVersion in which the receiver was originally committed." + ^ self mcModel ifNotNil: [ : model | model originOf: self ]! Item was added: + ----- Method: MCDefinition>>sortHistory: (in category 'private') ----- + sortHistory: anOrderedCollection + ^ anOrderedCollection sort: [ : a : b | a dateAndTime > b dateAndTime ]! Item was changed: ----- Method: MCFileBasedRepository>>cacheAllFileNamesDuring: (in category 'private') ----- cacheAllFileNamesDuring: aBlock "Cache the result of #allFileNames and #allVersionNames during aBlock" allFileNamesCache ifNotNil: [ ^ aBlock value ]. self cacheAllFilenames. + ^ aBlock ensure: [ allFileNamesCache := allVersionNamesCache := nil ]! - ^ aBlock ensure: [ self flushAllFilenames ]! Item was changed: ----- Method: MCFileBasedRepository>>cacheAllFilenames (in category 'private') ----- cacheAllFilenames + allFileNamesCache := self allFileNames. + allVersionNamesCache := self allVersionNames! - allFileNamesCache ifNil: - [ allFileNamesCache := self allFileNames. - allVersionNamesCache := self allVersionNames ]! Item was added: + ----- Method: MCHttpRepository class>>initialize (in category 'class initialization') ----- + initialize + self unload. + (ServiceRegistry current serviceWithId: #browserMethodMenu) services + add: self browseMcMethodHistoryService ; + add: self browseMcMethodOriginService. + (ServiceRegistry current serviceWithId: #browserClassMenu) services + add: self browseMcClassHistoryService ; + add: self browseMcClassOriginService! Item was added: + ----- Method: MCHttpRepository class>>trunk (in category 'well-known repositories') ----- + trunk + ^ MCRepositoryGroup default repositories + detect: + [ : each | each isTrunk ] + ifNone: + [ MCHttpRepository + location: MCHttpRepository trunkUrlString + user: 'squeak' + password: 'squeak' ]! Item was added: + ----- Method: MCHttpRepository class>>trunkUrlString (in category 'accessing') ----- + trunkUrlString + ^ 'http://source.squeak.org/trunk'! Item was changed: + ----- Method: MCHttpRepository>>allFileNames (in category 'overriding') ----- - ----- Method: MCHttpRepository>>allFileNames (in category 'required') ----- allFileNames | index | self displayProgress: 'Updating ', self description during:[ index := HTTPSocket httpGet: self locationWithTrailingSlash, '?C=M;O=D' args: nil user: self user passwd: self password. ]. index isString ifTrue: [NetworkError signal: 'Could not access ', location]. ^ self parseFileNamesFromStream: index ! Item was changed: + ----- Method: MCHttpRepository>>asCreationTemplate (in category 'overriding') ----- - ----- Method: MCHttpRepository>>asCreationTemplate (in category 'as yet unclassified') ----- asCreationTemplate ^self class creationTemplateLocation: location user: user password: password! Item was changed: + ----- Method: MCHttpRepository>>description (in category 'overriding') ----- - ----- Method: MCHttpRepository>>description (in category 'required') ----- description ^ location! Item was changed: + ----- Method: MCHttpRepository>>displayProgress:during: (in category 'private') ----- - ----- Method: MCHttpRepository>>displayProgress:during: (in category 'required') ----- displayProgress: label during: workBlock | nextUpdateTime | nextUpdateTime := 0. ^label displayProgressFrom: 0.0 to: 1.0 during:[:bar| bar value: 0.0. workBlock on: HTTPProgress do:[:ex| (ex total == nil or:[ex amount == nil]) ifFalse:[ (nextUpdateTime < Time millisecondClockValue or:[ex total = ex amount]) ifTrue:[ bar value: ex amount asFloat / ex total asFloat. nextUpdateTime := Time millisecondClockValue + 100. ]. ]. ex resume. ] ]. ! Item was changed: + ----- Method: MCHttpRepository>>flushCache (in category 'overriding') ----- - ----- Method: MCHttpRepository>>flushCache (in category 'required') ----- flushCache super flushCache. readerCache := nil.! Item was added: + ----- Method: MCHttpRepository>>historyOf: (in category 'accessing') ----- + historyOf: aMCDefinition + ^ (ReferenceStream on: + (self + httpGet: 'history' + for: aMCDefinition)) next! Item was added: + ----- Method: MCHttpRepository>>httpGet:for: (in category 'private') ----- + httpGet: actionString for: aMCDefinition + ^ HTTPSocket + httpGet: self locationWithTrailingSlash + args: + { 'action'->{actionString}. + 'mc-definition'-> {self serializeForRequest: aMCDefinition}} + user: self user + passwd: self password! Item was added: + ----- Method: MCHttpRepository>>isTrunk (in category 'testing') ----- + isTrunk + ^ location = self class trunkUrlString! Item was changed: + ----- Method: MCHttpRepository>>location: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>location: (in category 'as yet unclassified') ----- location: aUrlString location := aUrlString! Item was changed: + ----- Method: MCHttpRepository>>locationWithTrailingSlash (in category 'accessing') ----- - ----- Method: MCHttpRepository>>locationWithTrailingSlash (in category 'as yet unclassified') ----- locationWithTrailingSlash ^ (location endsWith: '/') ifTrue: [location] ifFalse: [location, '/']! Item was added: + ----- Method: MCHttpRepository>>mcModel (in category 'overriding') ----- + mcModel + "Answer the object which can respond to #historyOf: and #originOf:." + ^ (location = 'http://localhost:8888/trunk' or: [ location = 'http://box4.squeak.org:8888/trunk' ]) ifTrue: [ self ]! Item was added: + ----- Method: MCHttpRepository>>originOf: (in category 'accessing') ----- + originOf: aMCDefinition + ^ (ReferenceStream on: + (self + httpGet: 'origin' + for: aMCDefinition)) next! Item was changed: + ----- Method: MCHttpRepository>>parseFileNamesFromStream: (in category 'private') ----- - ----- Method: MCHttpRepository>>parseFileNamesFromStream: (in category 'as yet unclassified') ----- parseFileNamesFromStream: aStream | names fullName | names := OrderedCollection new. [aStream atEnd] whileFalse: [[aStream upTo: $<. {$a. $A. nil} includes: aStream next] whileFalse. aStream upTo: $". aStream atEnd ifFalse: [ fullName := aStream upTo: $". names add: fullName unescapePercents asMCVersionName ]]. ^ names! Item was changed: + ----- Method: MCHttpRepository>>password (in category 'accessing') ----- - ----- Method: MCHttpRepository>>password (in category 'as yet unclassified') ----- password self userAndPasswordFromSettingsDo: [:usr :pwd | ^pwd]. self user isEmpty ifTrue: [^password ifNil: ['']]. [password isEmptyOrNil] whileTrue: [ | answer | "Give the user a chance to change the login" answer := UIManager default request: 'User name for ', String cr, location initialAnswer: self user. answer isEmpty ifTrue: [^password] ifFalse: [self user: answer]. password := UIManager default requestPassword: 'Password for "', self user, '" at ', String cr, location. ]. ^ password! Item was changed: + ----- Method: MCHttpRepository>>password: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>password: (in category 'as yet unclassified') ----- password: passwordString password := passwordString! Item was changed: + ----- Method: MCHttpRepository>>readStreamForFileNamed:do: (in category 'private') ----- - ----- Method: MCHttpRepository>>readStreamForFileNamed:do: (in category 'required') ----- readStreamForFileNamed: aString do: aBlock | contents | self displayProgress: 'Downloading ', aString during:[ contents := HTTPSocket httpGet: (self urlForFileNamed: aString) args: nil user: self user passwd: self password. ]. ^ contents isString ifFalse: [aBlock value: contents]! Item was added: + ----- Method: MCHttpRepository>>serializeForRequest: (in category 'private') ----- + serializeForRequest: aMCDefinition + ^ ((ReferenceStream on: (RWBinaryOrTextStream on: ByteArray new)) + nextPut: aMCDefinition ; + yourself) contents asString encodeForHTTP! Item was changed: + ----- Method: MCHttpRepository>>urlForFileNamed: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>urlForFileNamed: (in category 'as yet unclassified') ----- urlForFileNamed: aString ^ self locationWithTrailingSlash, aString encodeForHTTP! Item was changed: + ----- Method: MCHttpRepository>>user (in category 'accessing') ----- - ----- Method: MCHttpRepository>>user (in category 'as yet unclassified') ----- user self userAndPasswordFromSettingsDo: [:usr :pwd | ^usr]. "not in settings" ^user ifNil: ['']! Item was changed: + ----- Method: MCHttpRepository>>user: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>user: (in category 'as yet unclassified') ----- user: userString user := userString! Item was changed: + ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'private') ----- - ----- Method: MCHttpRepository>>userAndPasswordFromSettingsDo: (in category 'as yet unclassified') ----- userAndPasswordFromSettingsDo: aBlock "The mcSettings file in ExternalSettings preferenceDirectory should contain entries for each account: account1: *myhost.mydomain* user:password account2: *otherhost.mydomain/somerep* dXNlcjpwYXNzd29yZA== That is it must start with 'account', followed by anything to distinguish accounts, and a colon. Then comes a match expression for the repository url, and after a space the user:password string. To not have the clear text password on your disc, you can base64 encode it: (Base64MimeConverter mimeEncode: 'user:password' readStream) contents " Settings ifNotNil: [ Settings keysAndValuesDo: [:key :value | | userAndPassword entry | (key asLowercase beginsWith: 'account') ifTrue: [ entry := value findTokens: ' '. (entry first match: location) ifTrue: [ userAndPassword := entry second. (userAndPassword includes: $:) ifFalse: [ userAndPassword := (Base64MimeConverter mimeDecodeToChars: userAndPassword readStream) contents]. userAndPassword := userAndPassword findTokens: $:. ^aBlock value: userAndPassword first value: userAndPassword second ] ] ] ]. ^nil! Item was changed: + ----- Method: MCHttpRepository>>versionReaderForFileNamed: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>versionReaderForFileNamed: (in category 'as yet unclassified') ----- versionReaderForFileNamed: aString readerCache ifNil: [readerCache := Dictionary new]. ^ readerCache at: aString ifAbsent: [self resizeCache: readerCache. super versionReaderForFileNamed: aString do: [:r | r ifNotNil: [readerCache at: aString put: r]]] ! Item was changed: + ----- Method: MCHttpRepository>>versionReaderForFileNamed:do: (in category 'accessing') ----- - ----- Method: MCHttpRepository>>versionReaderForFileNamed:do: (in category 'as yet unclassified') ----- versionReaderForFileNamed: aString do: aBlock ^ (self versionReaderForFileNamed: aString) ifNotNil: aBlock! Item was changed: + ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'private') ----- - ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream response statusLine code | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. self displayProgress: 'Uploading ', aString during:[ response := HTTPSocket httpPut: stream contents to: (self urlForFileNamed: aString) user: self user passwd: self password. ]. "More robust handling of HTTP responses. Instead of enumerating all possible return codes and http versions, do a quick parse" (response beginsWith: 'HTTP/') ifTrue:[ "Looks like an HTTP header, not some error message" statusLine := response copyUpTo: Character cr. code := [(statusLine findTokens: ' ') second asInteger] on: Error do:[]. ]. (code isInteger and:[code between: 200 and: 299]) ifFalse:[self error: response].! Item was changed: + MCOperationsBrowser subclass: #MCMergeBrowser - MCPatchBrowser subclass: #MCMergeBrowser instanceVariableNames: 'conflicts merger ok' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: ----- Method: MCMergeBrowser>>items (in category 'as yet unclassified') ----- items + ^ conflicts, super items! - ^ conflicts, items! Item was added: + MCCodeTool subclass: #MCOperationsBrowser + instanceVariableNames: 'selection' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-UI'! Item was added: + ----- Method: MCOperationsBrowser class>>items: (in category 'creation') ----- + items: aCollection + ^ self new + setItems: aCollection ; + yourself! Item was added: + ----- Method: MCOperationsBrowser>>annotations (in category 'accessing') ----- + annotations + ^selection ifNil: [ super annotations ] + ifNotNil: [ selection annotations ]! Item was added: + ----- Method: MCOperationsBrowser>>buttonSpecs (in category 'ui') ----- + buttonSpecs + ^ #((Invert invert 'Show the reverse set of changes') + (Export export 'Export the changes as a change set'))! Item was added: + ----- Method: MCOperationsBrowser>>changeSetNameForInstall (in category 'accessing') ----- + changeSetNameForInstall + "Answer the name of the change set into which my selection will be installed. + Derive this from my label. + If I have no label, use the current change set." + + | tokens | + label ifNil: [ ^ChangeSet current name ]. + tokens := label findTokens: ' '. + tokens removeAllFoundIn: { 'changes'. 'between'. 'and' }. + (tokens size = 3 and: [ tokens second = '<working' ]) ifTrue: [ ^tokens first, '-to-working' ]. + tokens size = 2 ifFalse: [ ^'InstalledPatches' ]. + ^'{1}-to-{2}' format: tokens ! Item was added: + ----- Method: MCOperationsBrowser>>defaultLabel (in category 'ui') ----- + defaultLabel + ^ label ifNil: [ 'History Browser' ]! Item was added: + ----- Method: MCOperationsBrowser>>installSelection (in category 'actions') ----- + installSelection + | loader | + selection ifNotNil: + [loader := MCPackageLoader new. + selection applyTo: loader. + loader loadWithName: self changeSetNameForInstall ]! Item was added: + ----- Method: MCOperationsBrowser>>invert (in category 'selecting') ----- + invert + items := items collect: [:ea | ea inverse]. + self changed: #list; changed: #text; changed: #selection! Item was added: + ----- Method: MCOperationsBrowser>>list (in category 'accessing') ----- + list + ^ self items collect: [:ea | ea summary]! Item was added: + ----- Method: MCOperationsBrowser>>methodListMenu: (in category 'menus') ----- + methodListMenu: aMenu + selection ifNotNil: + [aMenu addList:#( + ('install' installSelection) + ('revert' revertSelection) + -)]. + self unchangedMethods ifNotEmpty: + [aMenu addList:#( + ('revert unchanged methods...' revertUnchangedMethods) + -)]. + super methodListMenu: aMenu. + ^ aMenu + ! Item was added: + ----- Method: MCOperationsBrowser>>perform:orSendTo: (in category 'ui') ----- + perform: selector orSendTo: otherTarget + "Selector was just chosen from a menu by a user. If can respond, then + perform it on myself. If not, send it to otherTarget, presumably the + editPane from which the menu was invoked." + + (self respondsTo: selector) + ifTrue: [^ self perform: selector] + ifFalse: [^ otherTarget perform: selector]! Item was added: + ----- Method: MCOperationsBrowser>>revertSelection (in category 'actions') ----- + revertSelection + | loader | + selection ifNotNil: + [loader := MCPackageLoader new. + selection inverse applyTo: loader. + loader loadWithName: self changeSetNameForInstall ]! Item was added: + ----- Method: MCOperationsBrowser>>revertUnchangedMethods (in category 'actions') ----- + revertUnchangedMethods + "revert methods that only have changed timestamps" + | loader unchangedMethods | + unchangedMethods := items select: [:op | op isUnchangedMethod]. + (self confirm: ('Revert {1} methods that only differ in timestamp?' translated format: {unchangedMethods size})) + ifTrue: [ + loader := MCPackageLoader new. + unchangedMethods do: [:op | op inverse applyTo: loader]. + loader loadWithName: self changeSetNameForInstall]. + ! Item was added: + ----- Method: MCOperationsBrowser>>selectedClass (in category 'subclassResponsibility') ----- + selectedClass + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + definition isMethodDefinition ifFalse: [ ^nil ]. + ^Smalltalk at: definition className ifAbsent: [ ]! Item was added: + ----- Method: MCOperationsBrowser>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- + selectedClassOrMetaClass + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + (definition isMethodDefinition or: [definition isClassDefinition]) ifFalse: [ ^nil ]. + ^definition actualClass! Item was added: + ----- Method: MCOperationsBrowser>>selectedMessageCategoryName (in category 'subclassResponsibility') ----- + selectedMessageCategoryName + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + definition isMethodDefinition ifFalse: [ ^nil ]. + ^definition category! Item was added: + ----- Method: MCOperationsBrowser>>selectedMessageName (in category 'subclassResponsibility') ----- + selectedMessageName + | definition | + selection ifNil: [ ^nil ]. + (definition := selection definition) ifNil: [ ^nil ]. + definition isMethodDefinition ifFalse: [ ^nil ]. + ^definition selector! Item was added: + ----- Method: MCOperationsBrowser>>selection (in category 'selecting') ----- + selection + ^ selection + ifNil: [0] + ifNotNil: [self items indexOf: selection]! Item was added: + ----- Method: MCOperationsBrowser>>selection: (in category 'selecting') ----- + selection: aNumber + selection := aNumber = 0 ifFalse: [self items at: aNumber]. + self changed: #selection; changed: #text; changed: #annotations! Item was added: + ----- Method: MCOperationsBrowser>>text (in category 'text') ----- + text + ^ selection ifNil: [''] ifNotNil: [selection source]! Item was added: + ----- Method: MCOperationsBrowser>>text: (in category 'text') ----- + text: aTextOrString + self changed: #text! Item was added: + ----- Method: MCOperationsBrowser>>unchangedMethods (in category 'accessing') ----- + unchangedMethods + ^ items select: [:op | op isUnchangedMethod]! Item was added: + ----- Method: MCOperationsBrowser>>widgetSpecs (in category 'ui') ----- + widgetSpecs + Preferences annotationPanes ifFalse: [ ^#( + ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((textMorph: text) (0 0.4 1 1)) + ) ]. + + ^ { + #((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)). + { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. 0. 0. self defaultAnnotationPaneHeight. } }. + { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultAnnotationPaneHeight. 0. 0. } }. + }! Item was added: + Object subclass: #MCOperationsList + instanceVariableNames: 'operations' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Patching'! Item was added: + ----- Method: MCOperationsList class>>operations: (in category 'create') ----- + operations: aCollection + ^ self basicNew initializeWithOperations: aCollection! Item was added: + ----- Method: MCOperationsList>>browse (in category 'ui') ----- + browse + (self browserClass items: operations) show! Item was added: + ----- Method: MCOperationsList>>browserClass (in category 'ui') ----- + browserClass + ^ MCOperationsBrowser! Item was added: + ----- Method: MCOperationsList>>initializeWithOperations: (in category 'intializing') ----- + initializeWithOperations: aCollection + operations := aCollection! Item was added: + ----- Method: MCOperationsList>>isEmpty (in category 'querying') ----- + isEmpty + ^ operations isEmpty! Item was added: + ----- Method: MCOperationsList>>operations (in category 'accessing') ----- + operations + ^ operations! Item was changed: ----- Method: MCPackageLoader>>basicLoad (in category 'private') ----- basicLoad "Load the contents of some package. This is the core loading method in Monticello. Be wary about modifying it unless you understand the details and dependencies of the various entities being modified." | pkgName | errorDefinitions := OrderedCollection new. "Obviously this isn't the package name but we don't have anything else to use here. ChangeSet current name will generally work since a CS is usually installed prior to installation." pkgName := ChangeSet current name. preamble ifNotNil: [ChangeSet current preambleString: (self preambleAsCommentNamed: pkgName)]. - RecentMessages default suspendWhile: [ [CurrentReadOnlySourceFiles cacheDuring: [[ "Pass 1: Load everything but the methods, which are collected in methodAdditions." additions do: [:ea | ea isMethodDefinition ifTrue:[methodAdditions add: ea asMethodAddition] ifFalse:[[ea load]on: Error do: [errorDefinitions add: ea]]. ] displayingProgress: 'Reshaping ', pkgName. "Try again any delayed definitions" self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. errorDefinitions do: [:ea | ea load] displayingProgress: 'Reloading ', pkgName. "Pass 2: We compile new / changed methods" methodAdditions do:[:ea| ea createCompiledMethod] displayingProgress: 'Compiling ', pkgName. 'Installing ', pkgName displayProgressFrom: 0 to: 2 during:[:bar| "There is no progress *during* installation since a progress bar update will redraw the world and potentially call methods that we're just trying to install." bar value: 1. "Pass 3: Install the new / changed methods (this is a separate pass to allow compiler changes to be loaded)" methodAdditions do:[:ea| ea installMethod]. "Pass 4: Remove the obsolete methods" removals do:[:ea| ea unload]. ]. "Finally, notify observers for the method additions" methodAdditions do: [:each | each notifyObservers] "the message is fake but actually telling people how much time we spend in the notifications is embarrassing so lie instead" displayingProgress: 'Installing ', pkgName. additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing ', pkgName. ] on: InMidstOfFileinNotification do: [:n | n resume: true] + ]] ensure: [self flushChangesFile]! - ]] ensure: [self flushChangesFile] - ]! Item was changed: + MCOperationsList subclass: #MCPatch + instanceVariableNames: '' - Object subclass: #MCPatch - instanceVariableNames: 'operations' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Patching'! Item was changed: + ----- Method: MCPatch class>>fromBase:target: (in category 'create') ----- - ----- Method: MCPatch class>>fromBase:target: (in category 'as yet unclassified') ----- fromBase: baseSnapshot target: targetSnapshot ^ self new initializeWithBase: baseSnapshot target: targetSnapshot! Item was removed: - ----- Method: MCPatch class>>operations: (in category 'as yet unclassified') ----- - operations: aCollection - ^ self basicNew initializeWithOperations: aCollection! Item was changed: ----- Method: MCPatch>>browse (in category 'ui') ----- browse + (self browserClass forPatch: self) show! - ^ (MCPatchBrowser forPatch: self) show! Item was added: + ----- Method: MCPatch>>browserClass (in category 'ui') ----- + browserClass + ^ MCPatchBrowser! Item was changed: + ----- Method: MCPatch>>initializeWithBase:target: (in category 'initialize-release') ----- - ----- Method: MCPatch>>initializeWithBase:target: (in category 'intializing') ----- initializeWithBase: baseSnapshot target: targetSnapshot | base target | operations := OrderedCollection new. base := MCDefinitionIndex definitions: baseSnapshot definitions. target := MCDefinitionIndex definitions: targetSnapshot definitions. target definitions do: [:t | base definitionLike: t ifPresent: [:b | (b isSameRevisionAs: t) ifFalse: [operations add: (MCModification of: b to: t)]] ifAbsent: [operations add: (MCAddition of: t)]] displayingProgress: 'Diffing...'. base definitions do: [:b | target definitionLike: b ifPresent: [:t] ifAbsent: [operations add: (MCRemoval of: b)]] ! Item was removed: - ----- Method: MCPatch>>initializeWithOperations: (in category 'intializing') ----- - initializeWithOperations: aCollection - operations := aCollection! Item was removed: - ----- Method: MCPatch>>isEmpty (in category 'querying') ----- - isEmpty - ^ operations isEmpty! Item was removed: - ----- Method: MCPatch>>operations (in category 'accessing') ----- - operations - ^ operations! Item was changed: + MCOperationsBrowser subclass: #MCPatchBrowser + instanceVariableNames: '' - MCCodeTool subclass: #MCPatchBrowser - instanceVariableNames: 'selection' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: + ----- Method: MCPatchBrowser class>>forPatch: (in category 'instance creation') ----- - ----- Method: MCPatchBrowser class>>forPatch: (in category 'as yet unclassified') ----- forPatch: aPatch ^ self new patch: aPatch! Item was removed: - ----- Method: MCPatchBrowser>>annotations (in category 'as yet unclassified') ----- - annotations - ^selection ifNil: [ super annotations ] - ifNotNil: [ selection annotations ]! Item was removed: - ----- Method: MCPatchBrowser>>buttonSpecs (in category 'morphic ui') ----- - buttonSpecs - ^ #((Invert invert 'Show the reverse set of changes') - (Export export 'Export the changes as a change set'))! Item was removed: - ----- Method: MCPatchBrowser>>changeSetNameForInstall (in category 'as yet unclassified') ----- - changeSetNameForInstall - "Answer the name of the change set into which my selection will be installed. - Derive this from my label. - If I have no label, use the current change set." - - | tokens | - label ifNil: [ ^ChangeSet current name ]. - tokens := label findTokens: ' '. - tokens removeAllFoundIn: { 'changes'. 'between'. 'and' }. - (tokens size = 3 and: [ tokens second = '<working' ]) ifTrue: [ ^tokens first, '-to-working' ]. - tokens size = 2 ifFalse: [ ^'InstalledPatches' ]. - ^'{1}-to-{2}' format: tokens ! Item was changed: + ----- Method: MCPatchBrowser>>defaultLabel (in category 'ui') ----- - ----- Method: MCPatchBrowser>>defaultLabel (in category 'morphic ui') ----- defaultLabel ^ 'Patch Browser'! Item was removed: - ----- Method: MCPatchBrowser>>installSelection (in category 'actions') ----- - installSelection - | loader | - selection ifNotNil: - [loader := MCPackageLoader new. - selection applyTo: loader. - loader loadWithName: self changeSetNameForInstall ]! Item was removed: - ----- Method: MCPatchBrowser>>invert (in category 'selecting') ----- - invert - items := items collect: [:ea | ea inverse]. - self changed: #list; changed: #text; changed: #selection! Item was removed: - ----- Method: MCPatchBrowser>>items (in category 'accessing') ----- - items - ^ items! Item was removed: - ----- Method: MCPatchBrowser>>list (in category 'accessing') ----- - list - ^ self items collect: [:ea | ea summary]! Item was removed: - ----- Method: MCPatchBrowser>>methodListMenu: (in category 'menus') ----- - methodListMenu: aMenu - selection ifNotNil: - [aMenu addList:#( - ('install' installSelection) - ('revert' revertSelection) - -)]. - self unchangedMethods ifNotEmpty: - [aMenu addList:#( - ('revert unchanged methods...' revertUnchangedMethods) - -)]. - super methodListMenu: aMenu. - ^ aMenu - ! Item was changed: + ----- Method: MCPatchBrowser>>patch: (in category 'initialize-release') ----- - ----- Method: MCPatchBrowser>>patch: (in category 'accessing') ----- patch: aPatch items := aPatch operations asSortedCollection! Item was removed: - ----- Method: MCPatchBrowser>>perform:orSendTo: (in category 'morphic ui') ----- - perform: selector orSendTo: otherTarget - "Selector was just chosen from a menu by a user. If can respond, then - perform it on myself. If not, send it to otherTarget, presumably the - editPane from which the menu was invoked." - - (self respondsTo: selector) - ifTrue: [^ self perform: selector] - ifFalse: [^ otherTarget perform: selector]! Item was removed: - ----- Method: MCPatchBrowser>>revertSelection (in category 'actions') ----- - revertSelection - | loader | - selection ifNotNil: - [loader := MCPackageLoader new. - selection inverse applyTo: loader. - loader loadWithName: self changeSetNameForInstall ]! Item was removed: - ----- Method: MCPatchBrowser>>revertUnchangedMethods (in category 'actions') ----- - revertUnchangedMethods - "revert methods that only have changed timestamps" - | loader unchangedMethods | - unchangedMethods := items select: [:op | op isUnchangedMethod]. - (self confirm: ('Revert {1} methods that only differ in timestamp?' translated format: {unchangedMethods size})) - ifTrue: [ - loader := MCPackageLoader new. - unchangedMethods do: [:op | op inverse applyTo: loader]. - loader loadWithName: self changeSetNameForInstall]. - ! Item was removed: - ----- Method: MCPatchBrowser>>selectedClass (in category 'subclassResponsibility') ----- - selectedClass - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^Smalltalk at: definition className ifAbsent: [ ]! Item was removed: - ----- Method: MCPatchBrowser>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- - selectedClassOrMetaClass - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - (definition isMethodDefinition or: [definition isClassDefinition]) ifFalse: [ ^nil ]. - ^definition actualClass! Item was removed: - ----- Method: MCPatchBrowser>>selectedMessageCategoryName (in category 'subclassResponsibility') ----- - selectedMessageCategoryName - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^definition category! Item was removed: - ----- Method: MCPatchBrowser>>selectedMessageName (in category 'subclassResponsibility') ----- - selectedMessageName - | definition | - selection ifNil: [ ^nil ]. - (definition := selection definition) ifNil: [ ^nil ]. - definition isMethodDefinition ifFalse: [ ^nil ]. - ^definition selector! Item was removed: - ----- Method: MCPatchBrowser>>selection (in category 'selecting') ----- - selection - ^ selection - ifNil: [0] - ifNotNil: [self items indexOf: selection]! Item was removed: - ----- Method: MCPatchBrowser>>selection: (in category 'selecting') ----- - selection: aNumber - selection := aNumber = 0 ifFalse: [self items at: aNumber]. - self changed: #selection; changed: #text; changed: #annotations! Item was removed: - ----- Method: MCPatchBrowser>>text (in category 'text') ----- - text - ^ selection ifNil: [''] ifNotNil: [selection source]! Item was removed: - ----- Method: MCPatchBrowser>>text: (in category 'text') ----- - text: aTextOrString - self changed: #text! Item was removed: - ----- Method: MCPatchBrowser>>unchangedMethods (in category 'as yet unclassified') ----- - unchangedMethods - ^ items select: [:op | op isUnchangedMethod]! Item was removed: - ----- Method: MCPatchBrowser>>widgetSpecs (in category 'morphic ui') ----- - widgetSpecs - Preferences annotationPanes ifFalse: [ ^#( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) - ((textMorph: text) (0 0.4 1 1)) - ) ]. - - ^ { - #((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)). - { #(textMorph: annotations). #(0 0.4 1 0.4). { 0. 0. 0. self defaultAnnotationPaneHeight. } }. - { #(textMorph: text). #(0 0.4 1 1). { 0. self defaultAnnotationPaneHeight. 0. 0. } }. - }! Item was added: + ----- Method: MCRepository class>>browseMcClassHistoryService (in category 'ui-support') ----- + browseMcClassHistoryService + ^ ServiceAction + id: #browseMcClassHistory + text: 'browse mc history' + button: 'mc' + description: 'Browse the Monticello history of this class from the code repository.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcClassHistory ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcClassHistory ]! Item was added: + ----- Method: MCRepository class>>browseMcClassOriginService (in category 'ui-support') ----- + browseMcClassOriginService + ^ ServiceAction + id: #browseMcClassOrigin + text: 'browse mc origin' + button: 'mc' + description: 'Browse the Monticello version comments in which this class definition was originally committed.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcClassOrigin ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcClassHistory ]! Item was added: + ----- Method: MCRepository class>>browseMcMethodHistoryService (in category 'ui-support') ----- + browseMcMethodHistoryService + ^ ServiceAction + id: #browseMcMethodHistory + text: 'browse mc history' + button: 'mc' + description: 'Browse the Monticello history of this method from the code repository.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcMethodHistory ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcMethodHistory ]! Item was added: + ----- Method: MCRepository class>>browseMcMethodOriginService (in category 'ui-support') ----- + browseMcMethodOriginService + ^ ServiceAction + id: #browseMcMethodOrigin + text: 'browse mc origin' + button: 'mc' + description: 'Browse the Monticello version comments in which this edition of this method was originally committed.' + action: + [ : aBrowserRequestor | aBrowserRequestor browseMcMethodOrigin ] + condition: + [ : aBrowserRequestor | aBrowserRequestor canBrowseMcMethodHistory ]! Item was added: + ----- Method: MCRepository class>>packageCache (in category 'well-known repositories') ----- + packageCache + ^ MCCacheRepository default! Item was added: + ----- Method: MCRepository class>>trunk (in category 'well-known repositories') ----- + trunk + ^ MCHttpRepository trunk! Item was added: + ----- Method: MCRepository class>>unload (in category 'ui-support') ----- + unload + | methodMenuServiceCategory classMenuServiceCategory | + methodMenuServiceCategory := ServiceRegistry current serviceWithId: #browserMethodMenu. + methodMenuServiceCategory services copy do: + [ : each | (#(#browseMcMethodHistory #browseMcMethodOrigin ) includes: each id) ifTrue: [ methodMenuServiceCategory services remove: each ] ]. + classMenuServiceCategory := ServiceRegistry current serviceWithId: #browserClassMenu. + classMenuServiceCategory services copy do: + [ : each | (#(#browseMcClassHistory #browseMcClassOrigin ) includes: each id) ifTrue: [ classMenuServiceCategory services remove: each ] ]! Item was removed: - ----- Method: MCRepository>>flushAllFilenames (in category 'private') ----- - flushAllFilenames - "No-op. Subclasses override if necessary."! Item was added: + ----- Method: MCRepository>>isTrunk (in category 'testing') ----- + isTrunk + ^ false! Item was added: + ----- Method: MCRepository>>mcModel (in category '*monticello') ----- + mcModel + "Only Magma-based repositories employ a McModel instance." + ^ nil! Item was added: + ----- Method: MCRepositoryGroup>>cacheAllFilenames (in category 'private') ----- + cacheAllFilenames + repositories do: [ : each | each cacheAllFilenames ]! Item was added: + ----- Method: MCRepositoryGroup>>flushAllFilenames (in category 'private') ----- + flushAllFilenames + repositories do: [ : each | each flushAllFilenames ]! Item was added: + ----- Method: MCRepositoryGroup>>isTrunk (in category 'testing') ----- + isTrunk + ^ false! Item was added: + ----- Method: MethodReference>>mcHistory (in category '*monticello') ----- + mcHistory + "Answer a collection of MCMethodDefinitions for this method, which are in the first Magma-backed repository in the list of repositories of my working-copy." + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel historyOf: self asMethodDefinition ]! Item was added: + ----- Method: MethodReference>>mcModel (in category '*monticello') ----- + mcModel + "If my package is in a MCMagmaRepository, answer its mcModel." + ^ self asMethodDefinition mcModel! Item was added: + ----- Method: MethodReference>>mcOrigin (in category '*monticello') ----- + mcOrigin + "Answer the MCVersion in which this version of this method was originally committed." + ^ self mcModel ifNotNil: [ : mcmodel | mcmodel originOf: self ]! Item was added: + ----- Method: MethodReference>>mcPatchOperations (in category '*monticello') ----- + mcPatchOperations + "Answer a collection of MCPatchOperations that can be displayed in a MCPatchBrowser which will reflect the history of this objects definition in relation to each other (not simply compared to the image version)." + ^(self mcHistory reversed + inject: OrderedCollection new + into: + [ : coll : each | coll + ifEmpty: + [ coll + add: (MCAddition of: each) ; + yourself ] + ifNotEmpty: + [ coll + add: + (MCModification + of: + (coll last isAddition + ifTrue: [ coll last definition ] + ifFalse: [ coll last modification ]) + to: each) ; + yourself ] ]) reversed! Item was added: + ----- Method: MethodReference>>packageInfo (in category '*monticello') ----- + packageInfo + "Answer the PackageInfo containing this method." + | methodCategory classCategory | + methodCategory := self category. + classCategory := methodCategory first = $* ifFalse: [ self actualClass theNonMetaClass category ]. + ^ PackageInfo allPackages + detect: + [ : each | + "detect: [ : each | each methods includes: self ]" "<-- too slow" + (each isYourClassExtension: methodCategory) or: + [ classCategory notNil and: [ each systemCategories includes: classCategory ] ] ] + ifFound: [ : foundPackage | PackageInfo named: foundPackage packageName ] + ifNone: [ nil ]!

1 0

Daily Commit Log
by commits＠source.squeak.org 04 Oct '13

04 Oct '13

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2013-October/006480.ht… Name: Graphics-nice.247 Ancestors: Graphics-nice.246 Restore correct width of embedded morphs (recent regression). ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-October/006481.ht… Name: Compiler-cmm.275 Ancestors: Compiler-nice.274 When loading code, don't blow up just because of an undeclared ref. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-October/006482.ht… Name: System-cmm.600 Ancestors: System-fbs.599 - RecentMessages can now temporarily suspend, so it'll be able to avoid being blown away just from loading MC packages. - API consistency. - Test methods moved to Tests. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-October/006483.ht… Name: Tests-cmm.256 Ancestors: Tests-nice.255 Changes for updates to RecentMessages in System-cmm.600. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-October/006484.ht… Name: Monticello-cmm.573 Ancestors: Monticello-fbs.572 - Factor out cacheAllFilenames and flushAllFilenames to support special-case caching. - Stop obliterating Recent Messages when loading MC packages. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-October/006485.ht… Name: Graphics-nice.248 Ancestors: Graphics-nice.247 Fix small glitch: we must gobble all spaces before the one at which we wrap, but also all spaces after when we are justified. CompositionScanner>>crossedX is too long, split it in 3 understandable parts. Remove unused setConditionArray: Recategorize methods. =============================================

1 0

Upgrading serialized Morphs to new Paragraph stuff
by Chris Muller 03 Oct '13

03 Oct '13

Tim and Nicolas -- The removal of MultiNewParagraph presents a challenge for my serialized Maui panels; or most any serialized TextMorph for that matter. If you have any suggestions for a good procedure to upgrade them, please let me know. Right now I'm thinking: 1) load old UI panels in older image 2) update from trunk 3) save UI panels. Will that work?

4 8

← Newer
1
...
19
20
21
22
23
24
25
26
27
Older →

Jump to page: