Squeak-dev January 2014

squeak-dev@lists.squeakfoundation.org

55 participants
379 discussions

The Trunk: Collections-fbs.556.mcz
by commits＠source.squeak.org 03 Jan '14

03 Jan '14

Frank Shearar uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-fbs.556.mcz ==================== Summary ==================== Name: Collections-fbs.556 Author: fbs Time: 3 January 2014, 4:28:00.204 pm UUID: 80422ba6-f9b2-fc4f-acb2-27a911950eb9 Ancestors: Collections-fbs.555 While we debate whether we should even have an #ignoreStyleIfOnlyBold preference, make it a pragma preference. =============== Diff against Collections-fbs.555 =============== Item was changed: ArrayedCollection subclass: #Text instanceVariableNames: 'string runs' + classVariableNames: 'IgnoreStyleIfOnlyBold' - classVariableNames: '' poolDictionaries: 'TextConstants' category: 'Collections-Text'! !Text commentStamp: '<historical>' prior: 0! I represent a character string that has been marked with abstract changes in character appearance. Actual display is performed in the presence of a TextStyle which indicates, for each abstract code, an actual font to be used. A Text associates a set of TextAttributes with each character in its character string. These attributes may be font numbers, emphases such as bold or italic, or hyperling actions. Font numbers are interpreted relative to whatever textStyle appears, along with the text, in a Paragraph. Since most characters have the same attributes as their neighbors, the attributes are stored in a RunArray for efficiency. Each of my instances has string a String runs a RunArray! Item was added: + ----- Method: Text class>>ignoreStyleIfOnlyBold (in category 'preferences') ----- + ignoreStyleIfOnlyBold + <preference: 'Ignore style if only bold' category: 'browsing' description: 'If true, then any method submission in which the only style change is for bolding will be trated as a method with no style specifications.' type: #Boolean> + ^ IgnoreStyleIfOnlyBold ifNil: [true].! Item was added: + ----- Method: Text class>>ignoreStyleIfOnlyBold: (in category 'preferences') ----- + ignoreStyleIfOnlyBold: aBoolean + IgnoreStyleIfOnlyBold := aBoolean.! Item was changed: ----- Method: Text>>unembellished (in category 'attributes') ----- unembellished "Return true if the only emphases are the default font and bold" | font1 bold | font1 := TextFontChange defaultFontChange. bold := TextEmphasis bold. + Text ignoreStyleIfOnlyBold ifFalse: - Preferences ignoreStyleIfOnlyBold ifFalse: ["Ignore font1 only or font1-bold followed by font1-plain" ^ (runs values = (Array with: (Array with: font1))) or: [runs values = (Array with: (Array with: font1 with: bold) with: (Array with: font1))]]. "If preference is set, then ignore any combo of font1 and bold" runs withStartStopAndValueDo: [:start :stop :emphArray | emphArray do: [:emph | (font1 = emph or: [bold = emph]) ifFalse: [^ false]]]. ^ true! Item was changed: + (PackageInfo named: 'Collections') postscript: 'Text ignoreStyleIfOnlyBold: Preferences ignoreStyleIfOnlyBold. + Preferences removePreference: #ignoreStyleIfOnlyBold.'! - (PackageInfo named: 'Collections') postscript: 'LRUCache allInstancesDo: #migrate'!

1 0

The Trunk: Kernel-fbs.828.mcz
by commits＠source.squeak.org 03 Jan '14

03 Jan '14

Frank Shearar uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-fbs.828.mcz ==================== Summary ==================== Name: Kernel-fbs.828 Author: fbs Time: 3 January 2014, 11:37:55.998 am UUID: 7f0b6d62-9a2b-4448-bb09-437d34af6010 Ancestors: Kernel-fbs.827 Move some Tools functionality out of Kernel to Tools. =============== Diff against Kernel-fbs.827 =============== Item was removed: - ----- Method: Behavior>>inspectAllInstances (in category 'accessing instances and variables') ----- - inspectAllInstances - "Inpsect all instances of the receiver. 1/26/96 sw" - - | all allSize prefix | - all := self allInstances. - (allSize := all size) = 0 ifTrue: [^ self inform: 'There are no - instances of ', self name]. - prefix := allSize = 1 - ifTrue: ['The lone instance'] - ifFalse: ['The ', allSize printString, ' instances']. - - all asArray inspectWithLabel: (prefix, ' of ', self name)! Item was removed: - ----- Method: Behavior>>inspectSubInstances (in category 'accessing instances and variables') ----- - inspectSubInstances - "Inspect all instances of the receiver and all its subclasses. CAUTION - don't do this for something as generic as Object!! 1/26/96 sw" - - | all allSize prefix | - all := self allSubInstances. - (allSize := all size) = 0 ifTrue: [^ self inform: 'There are no - instances of ', self name, ' - or any of its subclasses']. - prefix := allSize = 1 - ifTrue: ['The lone instance'] - ifFalse: ['The ', allSize printString, ' instances']. - - all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! Item was removed: - ----- Method: ContextPart>>errorReportOn: (in category 'debugger access') ----- - errorReportOn: strm - "Write a detailed error report on the stack (above me) on a stream. For both the error file, and emailing a bug report. Suppress any errors while getting printStrings. Limit the length." - - | cnt aContext startPos | - strm print: Date today; space; print: Time now; cr. - strm cr. - strm nextPutAll: 'VM: '; - nextPutAll: Smalltalk platformName asString; - nextPutAll: ' - '; - nextPutAll: Smalltalk asString; - cr. - strm nextPutAll: 'Image: '; - nextPutAll: SystemVersion current version asString; - nextPutAll: ' ['; - nextPutAll: Smalltalk lastUpdateString asString; - nextPutAll: ']'; - cr. - strm cr. - SecurityManager default printStateOn: strm. - - "Note: The following is an open-coded version of ContextPart>>stackOfSize: since this method may be called during a low space condition and we might run out of space for allocating the full stack." - cnt := 0. startPos := strm position. - aContext := self. - [aContext notNil and: [(cnt := cnt + 1) < 20]] whileTrue: - [aContext printDetails: strm. "variable values" - strm cr. - aContext := aContext sender]. - - strm cr; nextPutAll: '--- The full stack ---'; cr. - aContext := self. - cnt := 0. - [aContext == nil] whileFalse: - [cnt := cnt + 1. - cnt = 20 ifTrue: [strm nextPutAll: ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'; cr]. - strm print: aContext; cr. "just class>>selector" - - "exit early if too long..." - strm position > (startPos+ self class maxLengthForASingleDebugLogReport) ifTrue: [strm nextPutAll: '...etc...'. ^ self]. cnt > self class maxStackDepthForASingleDebugLogReport ifTrue: [strm nextPutAll: '-- and more not shown --'. ^ self]. - aContext := aContext sender]. - ! Item was removed: - ----- Method: Object>>explore (in category 'user interface') ----- - explore - ^ToolSet explore: self! Item was removed: - ----- Method: Object>>inspectWithLabel: (in category 'user interface') ----- - inspectWithLabel: aLabel - "Create and schedule an Inspector in which the user can examine the receiver's variables." - ^ToolSet inspect: self label: aLabel! Item was removed: - ----- Method: Object>>notifyWithLabel: (in category 'error handling') ----- - notifyWithLabel: aString - "Create and schedule a Notifier with aString as the window label as well as the contents of the window, in order to request confirmation before a process can proceed." - - ToolSet - debugContext: thisContext - label: aString - contents: aString - - "nil notifyWithLabel: 'let us see if this works'"!

1 0

The Trunk: Tools-fbs.515.mcz
by commits＠source.squeak.org 03 Jan '14

03 Jan '14

Frank Shearar uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-fbs.515.mcz ==================== Summary ==================== Name: Tools-fbs.515 Author: fbs Time: 3 January 2014, 11:36:39.703 am UUID: eb2eb7de-3e2e-bb44-95a0-0f945bb74023 Ancestors: Tools-tpr.514 Move some Tools functionality out of Kernel to Tools. =============== Diff against Tools-tpr.514 =============== Item was added: + ----- Method: Behavior>>inspectAllInstances (in category '*Tools-accessing instances and variables') ----- + inspectAllInstances + "Inpsect all instances of the receiver. 1/26/96 sw" + + | all allSize prefix | + all := self allInstances. + (allSize := all size) = 0 ifTrue: [^ self inform: 'There are no + instances of ', self name]. + prefix := allSize = 1 + ifTrue: ['The lone instance'] + ifFalse: ['The ', allSize printString, ' instances']. + + all asArray inspectWithLabel: (prefix, ' of ', self name)! Item was added: + ----- Method: Behavior>>inspectSubInstances (in category '*Tools-accessing instances and variables') ----- + inspectSubInstances + "Inspect all instances of the receiver and all its subclasses. CAUTION - don't do this for something as generic as Object!! 1/26/96 sw" + + | all allSize prefix | + all := self allSubInstances. + (allSize := all size) = 0 ifTrue: [^ self inform: 'There are no + instances of ', self name, ' + or any of its subclasses']. + prefix := allSize = 1 + ifTrue: ['The lone instance'] + ifFalse: ['The ', allSize printString, ' instances']. + + all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! Item was added: + ----- Method: ContextPart>>errorReportOn: (in category '*Tools-debugger access') ----- + errorReportOn: strm + "Write a detailed error report on the stack (above me) on a stream. For both the error file, and emailing a bug report. Suppress any errors while getting printStrings. Limit the length." + + | cnt aContext startPos | + strm print: Date today; space; print: Time now; cr. + strm cr. + strm nextPutAll: 'VM: '; + nextPutAll: Smalltalk platformName asString; + nextPutAll: ' - '; + nextPutAll: Smalltalk asString; + cr. + strm nextPutAll: 'Image: '; + nextPutAll: SystemVersion current version asString; + nextPutAll: ' ['; + nextPutAll: Smalltalk lastUpdateString asString; + nextPutAll: ']'; + cr. + strm cr. + SecurityManager default printStateOn: strm. + + "Note: The following is an open-coded version of ContextPart>>stackOfSize: since this method may be called during a low space condition and we might run out of space for allocating the full stack." + cnt := 0. startPos := strm position. + aContext := self. + [aContext notNil and: [(cnt := cnt + 1) < 20]] whileTrue: + [aContext printDetails: strm. "variable values" + strm cr. + aContext := aContext sender]. + + strm cr; nextPutAll: '--- The full stack ---'; cr. + aContext := self. + cnt := 0. + [aContext == nil] whileFalse: + [cnt := cnt + 1. + cnt = 20 ifTrue: [strm nextPutAll: ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -'; cr]. + strm print: aContext; cr. "just class>>selector" + + "exit early if too long..." + strm position > (startPos+ self class maxLengthForASingleDebugLogReport) ifTrue: [strm nextPutAll: '...etc...'. ^ self]. cnt > self class maxStackDepthForASingleDebugLogReport ifTrue: [strm nextPutAll: '-- and more not shown --'. ^ self]. + aContext := aContext sender]. + ! Item was added: + ----- Method: Object>>explore (in category '*Tools-Explorer') ----- + explore + ^ToolSet explore: self! Item was added: + ----- Method: Object>>inspectWithLabel: (in category '*Tools-inspecting') ----- + inspectWithLabel: aLabel + "Create and schedule an Inspector in which the user can examine the receiver's variables." + ^ToolSet inspect: self label: aLabel! Item was added: + ----- Method: Object>>notifyWithLabel: (in category '*Tools-error handling') ----- + notifyWithLabel: aString + "Create and schedule a Notifier with aString as the window label as well as the contents of the window, in order to request confirmation before a process can proceed." + + ToolSet + debugContext: thisContext + label: aString + contents: aString + + "nil notifyWithLabel: 'let us see if this works'"! Item was changed: MessageSet subclass: #RecentMessageSet instanceVariableNames: '' + classVariableNames: 'NumberOfRecentSubmissionsToStore' - classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !RecentMessageSet commentStamp: 'sw 8/1/2002 17:40' prior: 0! RecentMessageSet is a message set that shows the most recently-submitted methods, in chronological order.!

1 0

Re: [squeak-dev] The Inbox: Collections-dtl.556.mcz
by Frank Shearar 03 Jan '14

03 Jan '14

On 2 January 2014 20:54, <commits(a)source.squeak.org> wrote: > David T. Lewis uploaded a new version of Collections to project The Inbox: > http://source.squeak.org/inbox/Collections-dtl.556.mcz > > ==================== Summary ==================== > > Name: Collections-dtl.556 > Author: dtl > Time: 2 January 2014, 3:54:39.379 pm > UUID: c115b70b-d18c-4f60-b218-2f48af79d653 > Ancestors: Collections-fbs.555 > > Simplify RunArray class>>scanFrom: by arranging for TextAttribute to create the appropriate instance. Remove explicit references to TextAttribute subclasses from RunArray. > > TextSqkProjectLink is a text attribute that controls project entry and is thus associated with Project.. Move it from Collections-Text to System-Support. > > =============== Diff against Collections-fbs.555 =============== > > Item was changed: > + ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'event handling') ----- > - ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'clicking') ----- > actOnClickFor: anObject > evalBlock ifNil: [ ^self ]. > evalBlock numArgs = 0 ifTrue: [ evalBlock value. ^true ]. > evalBlock numArgs = 1 ifTrue: [ evalBlock value: anObject. ^true ]. > self error: 'evalBlock should have 0 or 1 arguments'! > > Item was changed: > ----- Method: RunArray class>>scanFrom: (in category 'instance creation') ----- > scanFrom: strm > "Read the style section of a fileOut or sources file. nextChunk has already been done. We need to return a RunArray of TextAttributes of various kinds. These are written by the implementors of writeScanOn:" > | runs values attrList char | > (strm peekFor: $( ) ifFalse: [^ nil]. > runs := OrderedCollection new. > [strm skipSeparators. > strm peekFor: $)] whileFalse: > [runs add: (Number readFrom: strm)]. > values := OrderedCollection new. "Value array" > attrList := OrderedCollection new. "Attributes list" > + [(char := strm peek) == nil] whileFalse: [ > + char isSeparator > + ifTrue: [strm next "space, cr do nothing"] > + ifFalse: [char == $, > + ifTrue: [strm next. > + values add: attrList asArray. > + attrList := OrderedCollection new] > + ifFalse: [attrList add: (TextAttribute newFrom: strm)] > + ] Ah yes, that's a much better idea. I mean, it is a registry of sorts, but I must have been blind not to see this. Nice! frank

2 2

TextAttribute's #actonClickFor: - what package?
by Frank Shearar 02 Jan '14

02 Jan '14

Most of these are unclassified, except for TextURL's, which lives in Morphic. (This method references Morph directly, through an #isKindOf:.) Now the name strongly suggests that the method/group of methods belongs to a graphical UI, which makes me think that Morphic is, indeed, the place for them to live. But is it really? Could these methods live in Morphic for now, or do they really belong to a layer just below Morphic and ST80? (We see quite a few things in the image that are parts of or support for a GUI, but not any specific GUI. Transcripter, for instance. Is this layer the Graphics package?) frank

2 10

The Inbox: System-dtl.656.mcz
by commits＠source.squeak.org 02 Jan '14

02 Jan '14

David T. Lewis uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-dtl.656.mcz ==================== Summary ==================== Name: System-dtl.656 Author: dtl Time: 2 January 2014, 3:57:50.784 pm UUID: e0473c22-a892-48cc-ae8c-326bf541a5ca Ancestors: System-dtl.655 TextSqkProjectLink is a text attribute that controls project entry and is thus associated with Project.. Move it from Collections-Text to System-Support. (replaces System-dtl.655 which has incorrect version comment) =============== Diff against System-dtl.655 ===============

1 0

The Inbox: CollectionsTests-dtl.209.mcz
by commits＠source.squeak.org 02 Jan '14

02 Jan '14

David T. Lewis uploaded a new version of CollectionsTests to project The Inbox: http://source.squeak.org/inbox/CollectionsTests-dtl.209.mcz ==================== Summary ==================== Name: CollectionsTests-dtl.209 Author: dtl Time: 2 January 2014, 3:55:41.062 pm UUID: 5681f129-af93-4f97-9449-b2391be6c8a3 Ancestors: CollectionsTests-fbs.208 Provide TextAttributesScanningTest to verify text attribute filein and fileout. Five tests are marked as expected failures. These are tests for text attributes that are apparently unused, and that are likely candidates for removal from the image. There is one failure in a test for PluggableTextAttribute, which is a kind of text attribute that is used by SqueakMap. This is probably a legitimate failure that should be fixed. =============== Diff against CollectionsTests-fbs.208 =============== Item was added: + TestCase subclass: #TextAttributesScanningTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Text'! + + !TextAttributesScanningTest commentStamp: '<historical>' prior: 0! + A TextAttributesTest verifies storing and reading text attributes in file out chunk format. + ! Item was added: + ----- Method: TextAttributesScanningTest>>expectedFailures (in category 'running') ----- + expectedFailures + "Tests for text attributes that are apparently unused, and that may be candidates + for removal from the image" + ^#( + testTextAnchor + testTextIndent + testTextMessageLink + testTextPlusJumpStart + testTextPlusJumpEnd + )! Item was added: + ----- Method: TextAttributesScanningTest>>testPluggableTextAttribute (in category 'testing') ----- + testPluggableTextAttribute + | att strm | + att := PluggableTextAttribute evalBlock: [ #foo ]. + strm := ReadWriteStream on: ''. + self assert: (att respondsTo: #writeScanOn:). + att writeScanOn: strm. + "FIXME: PluggableTextAttribute used by SqueakMap. Currently it cannot + be filed out, so this probably needs fixing. See RunArray class>>scanFrom:" + ! Item was added: + ----- Method: TextAttributesScanningTest>>testRunArrayScan (in category 'testing') ----- + testRunArrayScan + | ra ra2 strm | + ra := RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i'). + strm := ReadWriteStream on: ''. + ra writeScanOn: strm. + strm reset. + ra2 := RunArray scanFrom: strm. + self assert: ra2 equals: ra + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextAction (in category 'testing') ----- + testTextAction + self assert: true + description: 'TextAction is abstract and does not need to support text filein and fileout'. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextAlignment (in category 'testing') ----- + testTextAlignment + | att strm att2 identifierCharacter att3 att4 | + att := TextAlignment leftFlush. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $a. + att2 :=TextAlignment new alignment: (Integer readFrom: strm ifFail: [-1]). + self assert: att equals: att2. + self assert: (TextAttribute classFor: $a) equals: TextAlignment. + + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $a. + att3 := TextAlignment scanFrom: strm. + self assert: att equals: att3. + self assert: (TextAttribute classFor: $a) equals: TextAlignment. + + strm reset. + att4 := TextAttribute newFrom: strm. + self assert: att equals: att4.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextAnchor (in category 'testing') ----- + testTextAnchor + | att strm | + att := TextAnchor new anchoredMorph: RectangleMorph new initialize. + strm := ReadWriteStream on: ''. + self assert: (att respondsTo: #writeScanOn:). + att writeScanOn: strm. "FIXME - is TextAnchor used for anything?" + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextAttributeClassFor (in category 'testing') ----- + testTextAttributeClassFor + "Verify class identifiers as used in RunArray class>>scanFrom:" + + self assert: (TextAttribute classFor: $a) equals: TextAlignment. + self assert: (TextAttribute classFor: $f) equals: TextFontChange. + self assert: (TextAttribute classFor: $F) equals: TextFontReference. + self assert: (TextAttribute classFor: $b) equals: TextEmphasis. + self assert: (TextAttribute classFor: $i) equals: TextEmphasis. + self assert: (TextAttribute classFor: $u) equals: TextEmphasis. + self assert: (TextAttribute classFor: $=) equals: TextEmphasis. + self assert: (TextAttribute classFor: $n) equals: TextEmphasis. + self assert: (TextAttribute classFor: $-) equals: TextKern. + self assert: (TextAttribute classFor: $+) equals: TextKern. + self assert: (TextAttribute classFor: $c) equals: TextColor. + self assert: (TextAttribute classFor: $L) equals: TextLink. + self assert: (TextAttribute classFor: $R) equals: TextURL. + self assert: (TextAttribute classFor: $q) equals: TextSqkPageLink. + self assert: (TextAttribute classFor: $p) equals: TextSqkProjectLink. + self assert: (TextAttribute classFor: $P) equals: TextPrintIt. + self assert: (TextAttribute classFor: $d) equals: TextDoIt. + + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextColor (in category 'testing') ----- + testTextColor + | att strm att2 att3 identifierCharacter | + att := TextColor color: Color red. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $c. + att2 := TextColor scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $c) equals: TextColor. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextDoIt (in category 'testing') ----- + testTextDoIt + | att strm att2 identifierCharacter att3 | + att := TextDoIt evalString: 'foo'. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $d. + att2 := TextDoIt scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $d) equals: TextDoIt. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextEmphasisBold (in category 'testing') ----- + testTextEmphasisBold + | att strm identifierCharacter att3 | + att := TextEmphasis bold. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $b. + self assert: strm atEnd. + self assert: (TextAttribute classFor: $b) equals: TextEmphasis. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextEmphasisItalic (in category 'testing') ----- + testTextEmphasisItalic + | att strm identifierCharacter att3 | + att := TextEmphasis italic. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $i. + self assert: strm atEnd. + self assert: (TextAttribute classFor: $i) equals: TextEmphasis. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextEmphasisNormal (in category 'testing') ----- + testTextEmphasisNormal + | att strm identifierCharacter att3 | + att := TextEmphasis normal. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $n. + self assert: strm atEnd. + self assert: (TextAttribute classFor: $n) equals: TextEmphasis. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextEmphasisStruckOut (in category 'testing') ----- + testTextEmphasisStruckOut + | att strm identifierCharacter att3 | + att := TextEmphasis struckOut. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $=. + self assert: strm atEnd. + self assert: (TextAttribute classFor: $=) equals: TextEmphasis. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextEmphasisUnderlined (in category 'testing') ----- + testTextEmphasisUnderlined + | att strm identifierCharacter att3 | + att := TextEmphasis underlined. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $u. + self assert: strm atEnd. + self assert: (TextAttribute classFor: $u) equals: TextEmphasis. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextFontChange (in category 'testing') ----- + testTextFontChange + | att strm att2 identifierCharacter att3 | + att := TextFontChange font3. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $f. + att2 := TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0]). + self assert: att equals: att2. + self assert: (TextAttribute classFor: $f) equals: TextFontChange. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextFontReference (in category 'testing') ----- + testTextFontReference + | font att strm identifierCharacter fontReferenceString att3 | + font := StrikeFont someInstance. + att := TextFontReference toFont: font. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $F. + fontReferenceString := strm upToEnd. + self assert: fontReferenceString equals: font familyName, '#', font height. + self assert: (TextAttribute classFor: $F) equals: TextFontReference. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3. + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextIndent (in category 'testing') ----- + testTextIndent + "TextIndent is unused and does not have in implemention to support text + filein and fileout. See TextAlignment for its likely replacement." + self fail: 'TextIndent is apparently unused'! Item was added: + ----- Method: TextAttributesScanningTest>>testTextKern (in category 'testing') ----- + testTextKern + | att strm att2 att3 | + + att := TextKern kern: 5. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + 5 timesRepeat: [self assert: strm next equals: $+]. + self assert: strm atEnd. + strm reset. + att2 := TextAttribute newFrom: strm. + self assert: att equals: att2. + + att := TextKern kern: -5. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + 5 timesRepeat: [self assert: strm next equals: $-]. + self assert: strm atEnd. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextLink (in category 'testing') ----- + testTextLink + | att strm att2 identifierCharacter att3 | + att := TextLink new classAndMethod: 'class and method string'. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $L. + att2 := TextLink scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $L) equals: TextLink. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextMessageLink (in category 'testing') ----- + testTextMessageLink + | att strm | + att := TextMessageLink message: Message someInstance. + strm := ReadWriteStream on: ''. + self assert: (att respondsTo: #writeScanOn:). + att writeScanOn: strm. "FIXME - is TextMessageLink used for anything?" + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextPlusJumpEnd (in category 'testing') ----- + testTextPlusJumpEnd + | att strm | + att := TextPlusJumpEnd new jumpLabel: 'this is a jump label'. + strm := ReadWriteStream on: ''. + self assert: (att respondsTo: #writeScanOn:). + att writeScanOn: strm. "FIXME - is TextPlusJumpEnd used for anything?" + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextPlusJumpStart (in category 'testing') ----- + testTextPlusJumpStart + | att strm | + att := TextPlusJumpStart new jumpLabel: 'this is a jump label'. + strm := ReadWriteStream on: ''. + self assert: (att respondsTo: #writeScanOn:). + att writeScanOn: strm. "FIXME - is TextPlusJumpStart used for anything?" + ! Item was added: + ----- Method: TextAttributesScanningTest>>testTextPrintIt (in category 'testing') ----- + testTextPrintIt + | att strm att2 identifierCharacter att3 | + att := TextPrintIt evalString: 'foo'. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $P. + att2 := TextPrintIt scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $P) equals: TextPrintIt. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextSqkPageLink (in category 'testing') ----- + testTextSqkPageLink + | att strm att2 identifierCharacter att3 | + att := TextSqkPageLink new url: 'a URL string'. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $q. + att2 := TextSqkPageLink scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $q) equals: TextSqkPageLink. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextSqkProjectLink (in category 'testing') ----- + testTextSqkProjectLink + | att strm att2 identifierCharacter att3 | + att := TextSqkProjectLink new url: 'a URL string'. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $p. + att2 := TextSqkProjectLink scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $p) equals: TextSqkProjectLink. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.! Item was added: + ----- Method: TextAttributesScanningTest>>testTextURL (in category 'testing') ----- + testTextURL + | att strm att2 identifierCharacter att3 | + att := TextURL new url: 'a URL string'. + strm := ReadWriteStream on: ''. + att writeScanOn: strm. + strm reset. + identifierCharacter := strm next. + self assert: identifierCharacter equals: $R. + att2 := TextURL scanFrom: strm. + self assert: att equals: att2. + self assert: (TextAttribute classFor: $R) equals: TextURL. + strm reset. + att3 := TextAttribute newFrom: strm. + self assert: att equals: att3.!

1 0

The Inbox: Collections-dtl.556.mcz
by commits＠source.squeak.org 02 Jan '14

02 Jan '14

David T. Lewis uploaded a new version of Collections to project The Inbox: http://source.squeak.org/inbox/Collections-dtl.556.mcz ==================== Summary ==================== Name: Collections-dtl.556 Author: dtl Time: 2 January 2014, 3:54:39.379 pm UUID: c115b70b-d18c-4f60-b218-2f48af79d653 Ancestors: Collections-fbs.555 Simplify RunArray class>>scanFrom: by arranging for TextAttribute to create the appropriate instance. Remove explicit references to TextAttribute subclasses from RunArray. TextSqkProjectLink is a text attribute that controls project entry and is thus associated with Project.. Move it from Collections-Text to System-Support. =============== Diff against Collections-fbs.555 =============== Item was changed: + ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'event handling') ----- - ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'clicking') ----- actOnClickFor: anObject evalBlock ifNil: [ ^self ]. evalBlock numArgs = 0 ifTrue: [ evalBlock value. ^true ]. evalBlock numArgs = 1 ifTrue: [ evalBlock value: anObject. ^true ]. self error: 'evalBlock should have 0 or 1 arguments'! Item was changed: ----- Method: RunArray class>>scanFrom: (in category 'instance creation') ----- scanFrom: strm "Read the style section of a fileOut or sources file. nextChunk has already been done. We need to return a RunArray of TextAttributes of various kinds. These are written by the implementors of writeScanOn:" | runs values attrList char | (strm peekFor: $( ) ifFalse: [^ nil]. runs := OrderedCollection new. [strm skipSeparators. strm peekFor: $)] whileFalse: [runs add: (Number readFrom: strm)]. values := OrderedCollection new. "Value array" attrList := OrderedCollection new. "Attributes list" + [(char := strm peek) == nil] whileFalse: [ + char isSeparator + ifTrue: [strm next "space, cr do nothing"] + ifFalse: [char == $, + ifTrue: [strm next. + values add: attrList asArray. + attrList := OrderedCollection new] + ifFalse: [attrList add: (TextAttribute newFrom: strm)] + ] - [(char := strm next) == nil] whileFalse: [ - char == $, ifTrue: [values add: attrList asArray. attrList := OrderedCollection new]. - char == $a ifTrue: [attrList add: - (TextAlignment new alignment: (Integer readFrom: strm ifFail: [0]))]. - char == $f ifTrue: [attrList add: - (TextFontChange new fontNumber: (Integer readFrom: strm ifFail: [0]))]. - char == $F ifTrue: [attrList add: (TextFontReference toFont: - (StrikeFont familyName: (strm upTo: $#) size: (Integer readFrom: strm ifFail: [0])))]. - char == $b ifTrue: [attrList add: (TextEmphasis bold)]. - char == $i ifTrue: [attrList add: (TextEmphasis italic)]. - char == $u ifTrue: [attrList add: (TextEmphasis underlined)]. - char == $= ifTrue: [attrList add: (TextEmphasis struckOut)]. - char == $n ifTrue: [attrList add: (TextEmphasis normal)]. - char == $- ifTrue: [attrList add: (TextKern kern: -1)]. - char == $+ ifTrue: [attrList add: (TextKern kern: 1)]. - char == $c ifTrue: [attrList add: (TextColor scanFrom: strm)]. "color" - char == $L ifTrue: [attrList add: (TextLink scanFrom: strm)]. "L not look like 1" - char == $R ifTrue: [attrList add: (TextURL scanFrom: strm)]. - "R capitalized so it can follow a number" - char == $q ifTrue: [attrList add: (TextSqkPageLink scanFrom: strm)]. - char == $p ifTrue: [attrList add: (TextSqkProjectLink scanFrom: strm)]. - char == $P ifTrue: [attrList add: (TextPrintIt scanFrom: strm)]. - char == $d ifTrue: [attrList add: (TextDoIt scanFrom: strm)]. - "space, cr do nothing" ]. values add: attrList asArray. ^ self runs: runs asArray values: (values copyFrom: 1 to: runs size) asArray " RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i') "! Item was added: + ----- Method: TextAlignment class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$a! Item was added: + ----- Method: TextAlignment class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: strm + ^self new alignment: (Integer readFrom: strm ifFail: [0])! Item was changed: + ----- Method: TextAlignment>>= (in category 'comparing') ----- - ----- Method: TextAlignment>>= (in category 'as yet unclassified') ----- = other ^ (other class == self class) and: [other alignment = alignment]! Item was changed: + ----- Method: TextAlignment>>alignment (in category 'accessing') ----- - ----- Method: TextAlignment>>alignment (in category 'as yet unclassified') ----- alignment ^alignment! Item was changed: + ----- Method: TextAlignment>>alignment: (in category 'accessing') ----- - ----- Method: TextAlignment>>alignment: (in category 'as yet unclassified') ----- alignment: aNumber alignment := aNumber.! Item was changed: + ----- Method: TextAlignment>>hash (in category 'comparing') ----- - ----- Method: TextAlignment>>hash (in category 'as yet unclassified') ----- hash "#hash is re-implemented because #= is re-implemented" ^ alignment hash! Item was changed: + ----- Method: TextAlignment>>writeScanOn: (in category 'scanning') ----- - ----- Method: TextAlignment>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm + strm nextPut: self class scanCharacter. - strm nextPut: $a. alignment printOn: strm.! Item was added: + ----- Method: TextAttribute class>>classFor: (in category 'fileIn/Out') ----- + classFor: scanCharacter + "Answer the class that uses scanCharacter to identify itself in a text fileout" + ^ self allSubclasses detect: [:cls | cls scanCharacters includes: scanCharacter] + ! Item was added: + ----- Method: TextAttribute class>>consumeIdentifierFrom: (in category 'fileIn/Out') ----- + consumeIdentifierFrom: scanStream. + "When scanning, a subclass may require access to the identifier character. + Otherwise, consume it here." + scanStream next! Item was added: + ----- Method: TextAttribute class>>newFrom: (in category 'instance creation') ----- + newFrom: scanStream + "scanStream contains a class identifier character possibly followed by data" + | cls | + cls := self classFor: scanStream peek. + cls consumeIdentifierFrom: scanStream. + ^cls scanFrom: scanStream! Item was added: + ----- Method: TextAttribute class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^nil! Item was added: + ----- Method: TextAttribute class>>scanCharacters (in category 'fileIn/Out') ----- + scanCharacters + "All scan characters corresponding to the given class. Usually this is an array of one." + ^Array with: self scanCharacter! Item was added: + ----- Method: TextColor class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$c! Item was changed: + ----- Method: TextColor class>>scanFrom: (in category 'fileIn/Out') ----- - ----- Method: TextColor class>>scanFrom: (in category 'instance creation') ----- scanFrom: strm "read a color in the funny format used by Text styles on files. c125000255 or cblue;" | r g b | strm peek isDigit ifTrue: [r := (strm next: 3) asNumber. g := (strm next: 3) asNumber. b := (strm next: 3) asNumber. ^ self color: (Color r: r g: g b: b range: 255)]. "A name of a color" ^ self color: (Color perform: (strm upTo: $;) asSymbol)! Item was changed: ----- Method: TextColor>>writeScanOn: (in category 'scanning') ----- writeScanOn: strm "Two formats. c125000255 or cblue;" | nn | + strm nextPut: self class scanCharacter. - strm nextPut: $c. (nn := color name) ifNotNil: [ (self class respondsTo: nn) ifTrue: [ ^ strm nextPutAll: nn; nextPut: $;]]. (Array with: color red with: color green with: color blue) do: [:float | | str | str := '000', (float * 255) asInteger printString. strm nextPutAll: (str copyFrom: str size-2 to: str size)]! Item was changed: + ----- Method: TextDoIt class>>evalString: (in category 'instance creation') ----- - ----- Method: TextDoIt class>>evalString: (in category 'as yet unclassified') ----- evalString: str ^ self new evalString: str! Item was added: + ----- Method: TextDoIt class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$d! Item was changed: + ----- Method: TextDoIt class>>scanFrom: (in category 'fileIn/Out') ----- - ----- Method: TextDoIt class>>scanFrom: (in category 'as yet unclassified') ----- scanFrom: strm "read a doit in the funny format used by Text styles on files. d10 factorial;; end with two semicolons" | pos end doit | pos := strm position. [strm skipTo: $;. strm peek == $;] whileFalse. end := strm position - 1. strm position: pos. doit := strm next: end-pos. strm skip: 2. ";;" ^ self evalString: doit! Item was added: + ----- Method: TextDoIt>>= (in category 'comparing') ----- + = textAttribute + ^ textAttribute class == self class + and: [textAttribute evalString = evalString]! Item was added: + ----- Method: TextDoIt>>evalString (in category 'accessing') ----- + evalString + ^evalString! Item was changed: + ----- Method: TextDoIt>>evalString: (in category 'accessing') ----- - ----- Method: TextDoIt>>evalString: (in category 'as yet unclassified') ----- evalString: str evalString := str ! Item was added: + ----- Method: TextDoIt>>hash (in category 'comparing') ----- + hash + ^evalString hash! Item was changed: ----- Method: TextDoIt>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm + strm nextPut: self class scanCharacter; nextPutAll: evalString; nextPutAll: ';;'! - strm nextPut: $d; nextPutAll: evalString; nextPutAll: ';;'! Item was changed: + ----- Method: TextEmphasis class>>bold (in category 'instance creation') ----- - ----- Method: TextEmphasis class>>bold (in category 'as yet unclassified') ----- bold ^ self new emphasisCode: 1! Item was added: + ----- Method: TextEmphasis class>>consumeIdentifierFrom: (in category 'fileIn/Out') ----- + consumeIdentifierFrom: scanStream. + "Do not consume the identifier character. Leave it in the stream + for use in identifying the type of emphasis." + ! Item was changed: + ----- Method: TextEmphasis class>>italic (in category 'instance creation') ----- - ----- Method: TextEmphasis class>>italic (in category 'as yet unclassified') ----- italic ^ self new emphasisCode: 2! Item was changed: + ----- Method: TextEmphasis class>>narrow (in category 'instance creation') ----- - ----- Method: TextEmphasis class>>narrow (in category 'as yet unclassified') ----- narrow ^ TextKern kern: -1! Item was changed: + ----- Method: TextEmphasis class>>normal (in category 'instance creation') ----- - ----- Method: TextEmphasis class>>normal (in category 'as yet unclassified') ----- normal ^ self new emphasisCode: 0! Item was added: + ----- Method: TextEmphasis class>>scanCharacters (in category 'fileIn/Out') ----- + scanCharacters + "All scan characters corresponding to this class. See writeScanOn:" + ^ #( $b $i $n $= $u )! Item was added: + ----- Method: TextEmphasis class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: strm + ^strm next + caseOf: { + [ $b ] -> [ self bold ] . + [ $i ] -> [ self italic ] . + [ $u ] -> [ self underlined ] . + [ $= ] -> [ self struckOut ] . + [ $n ] -> [ self normal ] + } + otherwise: [self error: 'unrecognized identifier ']! Item was changed: + ----- Method: TextEmphasis class>>struckOut (in category 'instance creation') ----- - ----- Method: TextEmphasis class>>struckOut (in category 'as yet unclassified') ----- struckOut ^ self new emphasisCode: 16! Item was changed: + ----- Method: TextEmphasis class>>underlined (in category 'instance creation') ----- - ----- Method: TextEmphasis class>>underlined (in category 'as yet unclassified') ----- underlined ^ self new emphasisCode: 4! Item was changed: + ----- Method: TextFontChange class>>defaultFontChange (in category 'instance creation') ----- - ----- Method: TextFontChange class>>defaultFontChange (in category 'as yet unclassified') ----- defaultFontChange "Answer a TextFontChange that represents the default font" ^ self new fontNumber: TextStyle default defaultFontIndex! Item was changed: + ----- Method: TextFontChange class>>font1 (in category 'instance creation') ----- - ----- Method: TextFontChange class>>font1 (in category 'as yet unclassified') ----- font1 ^ self new fontNumber: 1! Item was changed: + ----- Method: TextFontChange class>>font2 (in category 'instance creation') ----- - ----- Method: TextFontChange class>>font2 (in category 'as yet unclassified') ----- font2 ^ self new fontNumber: 2! Item was changed: + ----- Method: TextFontChange class>>font3 (in category 'instance creation') ----- - ----- Method: TextFontChange class>>font3 (in category 'as yet unclassified') ----- font3 ^ self new fontNumber: 3! Item was changed: + ----- Method: TextFontChange class>>font4 (in category 'instance creation') ----- - ----- Method: TextFontChange class>>font4 (in category 'as yet unclassified') ----- font4 ^ self new fontNumber: 4! Item was changed: + ----- Method: TextFontChange class>>fontNumber: (in category 'instance creation') ----- - ----- Method: TextFontChange class>>fontNumber: (in category 'as yet unclassified') ----- fontNumber: n ^ self new fontNumber: n! Item was added: + ----- Method: TextFontChange class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$f! Item was added: + ----- Method: TextFontChange class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: strm + ^self fontNumber: (Integer readFrom: strm ifFail: [0])! Item was changed: ----- Method: TextFontChange>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm + strm nextPut: self class scanCharacter. - strm nextPut: $f. fontNumber printOn: strm.! Item was added: + ----- Method: TextFontReference class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$F! Item was added: + ----- Method: TextFontReference class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: strm + ^self toFont: + (StrikeFont familyName: (strm upTo: $#) size: (Integer readFrom: strm ifFail: [0]))! Item was changed: ----- Method: TextFontReference>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm + strm nextPut: self class scanCharacter. - strm nextPut: $F. strm nextPutAll: font familyName; nextPut: $#. font height printOn: strm.! Item was added: + ----- Method: TextKern class>>consumeIdentifierFrom: (in category 'fileIn/Out') ----- + consumeIdentifierFrom: scanStream. + "Do not consume the identifier character. Leave it in the stream + for use in identifying the kern value." + ! Item was changed: + ----- Method: TextKern class>>kern: (in category 'instance creation') ----- - ----- Method: TextKern class>>kern: (in category 'as yet unclassified') ----- kern: kernValue ^ self new kern: kernValue! Item was added: + ----- Method: TextKern class>>scanCharacters (in category 'fileIn/Out') ----- + scanCharacters + "All scan characters corresponding to this class. See writeScanOn:" + ^ #( $- $+ )! Item was added: + ----- Method: TextKern class>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: strm + | char k | + char := strm next. + char = $+ + ifTrue: [ + k := 1. + [strm atEnd not and: [strm peek = char]] + whileTrue: [strm next. k := k + 1]. + ^ self kern: k]. + char = $- + ifTrue: [ + k := -1. + [strm atEnd not and: [strm peek = char]] + whileTrue: [strm next. k := k - 1]. + ^ self kern: k]. + self error: 'invalid identifier character' + + + ! Item was changed: + ----- Method: TextKern>>= (in category 'comparing') ----- - ----- Method: TextKern>>= (in category 'as yet unclassified') ----- = other ^ (other class == self class) and: [other kern = kern]! Item was changed: + ----- Method: TextKern>>couldDeriveFromPrettyPrinting (in category 'testing') ----- - ----- Method: TextKern>>couldDeriveFromPrettyPrinting (in category 'as yet unclassified') ----- couldDeriveFromPrettyPrinting ^ false! Item was changed: + ----- Method: TextKern>>dominatedByCmd0 (in category 'testing') ----- - ----- Method: TextKern>>dominatedByCmd0 (in category 'as yet unclassified') ----- dominatedByCmd0 "Cmd-0 should turn off kerning" ^ true! Item was changed: + ----- Method: TextKern>>dominates: (in category 'testing') ----- - ----- Method: TextKern>>dominates: (in category 'as yet unclassified') ----- dominates: other "NOTE: The use of active in this code is specific to its use in the method Text class addAttribute: att toArray: others" (active and: [other class == self class and: [other kern + kern = 0]]) ifTrue: [active := false. ^ true]. "can only dominate once" ^ false! Item was changed: + ----- Method: TextKern>>emphasizeScanner: (in category 'kerning') ----- - ----- Method: TextKern>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Augment (or diminish) the kerning offset for text display" scanner addKern: kern! Item was changed: + ----- Method: TextKern>>hash (in category 'comparing') ----- - ----- Method: TextKern>>hash (in category 'as yet unclassified') ----- hash "#hash is re-implemented because #= is re-implemented" ^kern hash! Item was changed: + ----- Method: TextKern>>kern (in category 'accessing') ----- - ----- Method: TextKern>>kern (in category 'as yet unclassified') ----- kern ^ kern! Item was changed: + ----- Method: TextKern>>kern: (in category 'initialize-release') ----- - ----- Method: TextKern>>kern: (in category 'as yet unclassified') ----- kern: kernValue kern := kernValue. self reset.! Item was changed: + ----- Method: TextKern>>reset (in category 'initialize-release') ----- - ----- Method: TextKern>>reset (in category 'as yet unclassified') ----- reset active := true! Item was changed: + ----- Method: TextKern>>set (in category 'initialize-release') ----- - ----- Method: TextKern>>set (in category 'as yet unclassified') ----- set ^ active! Item was changed: + ----- Method: TextKern>>writeScanOn: (in category 'scanning') ----- - ----- Method: TextKern>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm kern > 0 ifTrue: [ 1 to: kern do: [:kk | strm nextPut: $+]]. kern < 0 ifTrue: [ 1 to: 0-kern do: [:kk | strm nextPut: $-]].! Item was added: + ----- Method: TextLink class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$L! Item was changed: + ----- Method: TextLink class>>scanFrom: (in category 'fileIn/Out') ----- - ----- Method: TextLink class>>scanFrom: (in category 'as yet unclassified') ----- scanFrom: strm "read a link in the funny format used by Text styles on files. LPoint +;LPoint Comment;" ^ self new classAndMethod: (strm upTo: $;)! Item was added: + ----- Method: TextLink>>= (in category 'comparing') ----- + = other + ^ (other class == self class) + and: [other info = self info]! Item was changed: + ----- Method: TextLink>>actOnClickFor: (in category 'event handling') ----- - ----- Method: TextLink>>actOnClickFor: (in category 'as yet unclassified') ----- actOnClickFor: aMessageSet "Add to the end of the list. 'aClass selector', 'aClass Comment', 'aClass Definition', 'aClass Hierarchy' are the formats allowed." aMessageSet addItem: classAndMethod. ^ true! Item was changed: + ----- Method: TextLink>>analyze: (in category 'initialize-release') ----- - ----- Method: TextLink>>analyze: (in category 'as yet unclassified') ----- analyze: aString | list | list := super analyze: aString. classAndMethod := list at: 1. ^ list at: 2! Item was changed: + ----- Method: TextLink>>analyze:with: (in category 'initialize-release') ----- - ----- Method: TextLink>>analyze:with: (in category 'as yet unclassified') ----- analyze: aString with: nonMethod "Initalize this attribute holder with a piece text the user typed into a paragraph. Returns the text to emphesize (may be different from selection) Does not return self!!. nonMethod is what to show when clicked, i.e. the last part of specifier (Comment, Definition, or Hierarchy). May be of the form: Point <Point> Click Here<Point> <Point>Click Here " "Obtain the showing text and the instructions" | b1 b2 trim | b1 := aString indexOf: $<. b2 := aString indexOf: $>. (b1 < b2) & (b1 > 0) ifFalse: ["only one part" classAndMethod := self validate: aString, ' ', nonMethod. ^ classAndMethod ifNotNil: [aString]]. "Two parts" trim := aString withBlanksTrimmed. (trim at: 1) == $< ifTrue: [(trim last) == $> ifTrue: ["only instructions" classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod. ^ classAndMethod ifNotNil: [classAndMethod]] ifFalse: ["at the front" classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod. ^ classAndMethod ifNotNil: [aString copyFrom: b2+1 to: aString size]]] ifFalse: [(trim last) == $> ifTrue: ["at the end" classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod. ^ classAndMethod ifNotNil: [aString copyFrom: 1 to: b1-1]] ifFalse: ["Illegal -- <> has text on both sides" ^ nil]] ! Item was changed: + ----- Method: TextLink>>classAndMethod: (in category 'accessing') ----- - ----- Method: TextLink>>classAndMethod: (in category 'as yet unclassified') ----- classAndMethod: aString classAndMethod := aString! Item was added: + ----- Method: TextLink>>hash (in category 'comparing') ----- + hash + "#hash is re-implemented because #= is re-implemented" + ^classAndMethod hash! Item was changed: + ----- Method: TextLink>>info (in category 'accessing') ----- - ----- Method: TextLink>>info (in category 'as yet unclassified') ----- info ^ classAndMethod! Item was changed: + ----- Method: TextLink>>validate: (in category 'initialize-release') ----- - ----- Method: TextLink>>validate: (in category 'as yet unclassified') ----- validate: specString "Can this string be decoded to be Class space Method (or Comment, Definition, Hierarchy)? If so, return it in valid format, else nil" | list first mid last | list := specString findTokens: ' .|'. list isEmpty ifTrue: [ ^nil ]. last := list last. last first isUppercase ifTrue: [ (#('Comment' 'Definition' 'Hierarchy') includes: last) ifFalse: [^ nil]. "Check for 'Rectangle Comment Comment' and remove last one" (list at: list size - 1 ifAbsent: [^nil]) = last ifTrue: [list := list allButLast]]. list size > 3 ifTrue: [^ nil]. list size < 2 ifTrue: [^ nil]. Symbol hasInterned: list first ifTrue: [:sym | first := sym]. first ifNil: [^ nil]. Smalltalk at: first ifAbsent: [^ nil]. mid := list size = 3 ifTrue: [(list at: 2) = 'class' ifTrue: ['class '] ifFalse: [^ nil]] ifFalse: ['']. "OK if method name is not interned -- may not be defined yet" ^ first, ' ', mid, last! Item was changed: + ----- Method: TextLink>>writeScanOn: (in category 'scanning') ----- - ----- Method: TextLink>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm + strm nextPut: self class scanCharacter; nextPutAll: classAndMethod; nextPut: $;! - strm nextPut: $L; nextPutAll: classAndMethod; nextPut: $;! Item was added: + ----- Method: TextPrintIt class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$P! Item was removed: - ----- Method: TextPrintIt>>writeScanOn: (in category 'as yet unclassified') ----- - writeScanOn: strm - - strm nextPut: $P; nextPutAll: evalString; nextPutAll: ';;'! Item was added: + ----- Method: TextSqkPageLink class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$q! Item was removed: - ----- Method: TextSqkPageLink>>writeScanOn: (in category 'as yet unclassified') ----- - writeScanOn: strm - - strm nextPut: $q; nextPutAll: url; nextPut: $;! Item was removed: - TextURL subclass: #TextSqkProjectLink - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextSqkProjectLink>>actOnClickFor: (in category 'as yet unclassified') ----- - actOnClickFor: textMorph - - Project current enterIfThereOrFind: url. - ^ true! Item was removed: - ----- Method: TextSqkProjectLink>>analyze: (in category 'as yet unclassified') ----- - analyze: aString - - ^url := aString! Item was removed: - ----- Method: TextSqkProjectLink>>writeScanOn: (in category 'as yet unclassified') ----- - writeScanOn: strm - - strm nextPut: $p; nextPutAll: url; nextPut: $;! Item was added: + ----- Method: TextURL class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$R! Item was changed: + ----- Method: TextURL class>>scanFrom: (in category 'fileIn/Out') ----- - ----- Method: TextURL class>>scanFrom: (in category 'as yet unclassified') ----- scanFrom: strm "read a link in the funny format used by Text styles on files. Rhttp://www.disney.com;" ^ self new url: (strm upTo: $;)! Item was added: + ----- Method: TextURL>>= (in category 'comparing') ----- + = other + ^ (other class == self class) + and: [other info = self info]! Item was added: + ----- Method: TextURL>>hash (in category 'comparing') ----- + hash + "#hash is re-implemented because #= is re-implemented" + ^url hash! Item was changed: ----- Method: TextURL>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: strm + strm nextPut: self class scanCharacter; nextPutAll: url; nextPut: $;! - strm nextPut: $R; nextPutAll: url; nextPut: $;!

1 0

The Inbox: System-dtl.655.mcz
by commits＠source.squeak.org 02 Jan '14

02 Jan '14

David T. Lewis uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-dtl.655.mcz ==================== Summary ==================== Name: System-dtl.655 Author: dtl Time: 2 January 2014, 3:53:35.52 pm UUID: 5f60ccc7-5cb7-419c-a79d-c6ebbaf5b3da Ancestors: System-tpr.654 Provide TextAttributesScanningTest to verify text attribute filein and fileout. Five tests are marked as expected failures. These are tests for text attributes that are apparently unused, and that are likely candidates for removal from the image. There is one failure in a test for PluggableTextAttribute, which is a kind of text attribute that is used by SqueakMap. This is probably a legitimate failure that should be fixed. =============== Diff against System-tpr.654 =============== Item was added: + TextURL subclass: #TextSqkProjectLink + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Support'! Item was added: + ----- Method: TextSqkProjectLink class>>scanCharacter (in category 'fileIn/Out') ----- + scanCharacter + "The character used to identify a subclass of TextAttribute for filein and fileout" + ^$p! Item was added: + ----- Method: TextSqkProjectLink>>actOnClickFor: (in category 'as yet unclassified') ----- + actOnClickFor: textMorph + + Project current enterIfThereOrFind: url. + ^ true! Item was added: + ----- Method: TextSqkProjectLink>>analyze: (in category 'as yet unclassified') ----- + analyze: aString + + ^url := aString!

1 0

Re: [squeak-dev] The Trunk: Installer-Core-tpr.388.mcz
by Tobias Pape 02 Jan '14

02 Jan '14

On 01.01.2014, at 00:44, commits(a)source.squeak.org wrote: > tim Rowledge uploaded a new version of Installer-Core to project The Trunk: > http://source.squeak.org/trunk/Installer-Core-tpr.388.mcz > > ==================== Summary ==================== > > Name: Installer-Core-tpr.388 > Author: tpr > Time: 31 December 2013, 4:44:28.775 pm > UUID: c1f6039a-22f6-4024-97c4-0d5e7d6a53ac > Ancestors: Installer-Core-cmm.387 > > remove an unsent method as tagged by isThisEverCalled > > =============== Diff against Installer-Core-cmm.387 =============== > > Item was removed: > - ----- Method: Installer>>rememberAs: (in category 'custom names') ----- > - rememberAs: symbol > - self isThisEverCalled. > - self class remembered at: symbol asSymbol put: self! I believe it is unsent for a reason. I think this is purely for the End-users who wants to setup their own remembered Installer shortcuts. I’d rather opt for a test than remove that. Because if we remove #rememberAs, we certainly have to remove the whole #remembered infrastructure. Best -Tobias

4 6

Jump to page: