Squeak-dev May 2015

squeak-dev@lists.squeakfoundation.org

50 participants
615 discussions

The Trunk: MorphicTests-mt.30.mcz
by commits＠source.squeak.org 02 May '15

02 May '15

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-mt.30.mcz ==================== Summary ==================== Name: MorphicTests-mt.30 Author: mt Time: 2 May 2015, 12:38:36.255 pm UUID: 30f9a538-e3fa-034a-a612-123cf964e938 Ancestors: MorphicTests-mt.29 Tests added for pluggable text morphs. =============== Diff against MorphicTests-mt.29 =============== Item was added: + TestCase subclass: #PluggableTextMorphTest + instanceVariableNames: 'widget model' + classVariableNames: '' + poolDictionaries: '' + category: 'MorphicTests-Widgets'! Item was added: + ----- Method: PluggableTextMorphTest>>setUp (in category 'running') ----- + setUp + + super setUp. + + model := ValueHolder new contents: ''; yourself. + widget := PluggableTextMorph on: model text: #contents accept: #contents:.! Item was added: + ----- Method: PluggableTextMorphTest>>test01TextChangeInModel (in category 'tests') ----- + test01TextChangeInModel + + model contents: 'Hello, World!!'. + self assert: model contents equals: widget text asString.! Item was added: + ----- Method: PluggableTextMorphTest>>test02TextChangeInWidget (in category 'tests') ----- + test02TextChangeInWidget + + widget replaceSelectionWith: 'Hello, World!!'. + self assert: '' equals: model contents. + + widget accept. + self assert: widget text asString equals: model contents asString.! Item was added: + ----- Method: PluggableTextMorphTest>>test03TriggerAcceptFromModel (in category 'tests') ----- + test03TriggerAcceptFromModel + + widget replaceSelectionWith: 'Hello, World!!'. + self assert: widget hasUnacceptedEdits. + + model changed: #acceptChanges. + self assert: widget text asString equals: model contents asString.! Item was added: + ----- Method: PluggableTextMorphTest>>test04TriggerAcceptFromWidget (in category 'tests') ----- + test04TriggerAcceptFromWidget + + widget replaceSelectionWith: 'Hello, World!!'. + self assert: widget hasUnacceptedEdits. + + widget accept. + self assert: widget text asString equals: model contents asString.!

1 0

The Trunk: Morphic-mt.957.mcz
by commits＠source.squeak.org 02 May '15

02 May '15

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.957.mcz ==================== Summary ==================== Name: Morphic-mt.957 Author: mt Time: 2 May 2015, 12:36:22.238 pm UUID: d62a1d6a-7876-b44b-9d23-71ade2abb0e9 Ancestors: Morphic-mt.956 Allow models to trigger accept/revert changes in pluggable text morphs. Why? Provides an additional, more general way besides context menus or keyboard shortcuts. =============== Diff against Morphic-mt.956 =============== Item was changed: ----- Method: PluggableTextMorph>>update: (in category 'updating') ----- update: aSymbol aSymbol ifNil: [^self]. aSymbol == #flash ifTrue: [^self flash]. + aSymbol == getTextSelector ifTrue: [ self setText: self getText. getSelectionSelector ifNotNil: [self setSelection: self getSelection]. ^ self]. aSymbol == getSelectionSelector ifTrue: [^self setSelection: self getSelection]. + + aSymbol == #acceptChanges ifTrue: [^ self accept]. + aSymbol == #revertChanges ifTrue: [^ self cancel]. + (aSymbol == #autoSelect and: [getSelectionSelector notNil]) ifTrue: [self handleEdit: [(textMorph editor) abandonChangeText; "no replacement!!" setSearch: model autoSelectString; againOrSame: true]]. aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false]. aSymbol == #wantToChange ifTrue: [self canDiscardEdits ifFalse: [^self promptForCancel]. ^self]. aSymbol == #appendEntry ifTrue: [self handleEdit: [self appendEntry]. ^self refreshWorld]. aSymbol == #appendEntryLater ifTrue: [self handleEdit: [self appendEntry]]. aSymbol == #clearText ifTrue: [self handleEdit: [self changeText: Text new]. ^self refreshWorld]. aSymbol == #bs ifTrue: [self handleEdit: [self bsText]. ^self refreshWorld]. aSymbol == #codeChangedElsewhere ifTrue: [self hasEditingConflicts: true. ^self changed]. aSymbol == #saveContents ifTrue: + [^self saveContentsInFile]. + ! - [^self saveContentsInFile]!

1 0

Re: [squeak-dev] The Inbox: Collections-ul.624.mcz
by Levente Uzonyi 02 May '15

02 May '15

While I was trying to resurrect Character's ClassificationTable, I found that Unicode's ToLower and ToUpper table are initialized incorrectly. I changed the initialization code in Multilingual-ul.209 (and 208), which now uses the UnicodeData.txt file instead of CaseFolding.txt. This means that all #asUppercase and #asLowercase implementations will behave slightly differently (the worst one was Character's, which was still based on some LatinX encoding for byte characters). To review the changes load Multilingual-ul.209 from the Inbox first, then merge Collections-ul.624, and finally merge Collections-ul.625. Levente On Fri, 1 May 2015, commits(a)source.squeak.org wrote: > A new version of Collections was added to project The Inbox: > http://source.squeak.org/inbox/Collections-ul.624.mcz > > ==================== Summary ==================== > > Name: Collections-ul.624 > Author: ul > Time: 1 May 2015, 1:40:09.445 pm > UUID: a89640e5-e0cc-44e1-9613-e065b78258ad > Ancestors: Collections-tfel.623 > > Various improvements related to Characters and Strings. > > Resurrected Character's ClassificationTable > - initialize it based on the actual EncodedCharSet for leadingChar 0 (Unicode) > - added a bit for #isDigit > - added a mask for #isAlphaNumeirc > - use 0 as a tag if the uppercase or lowercase character value is greater than 255 > - initialize the table in the postscript (to not infere with #initialize) > > Character >> #encodedCharSet assumes than leadingChar 0 means Unicode. This is hardcoded in a few methods, so why not unify it here? > > Simpler and faster Character >> #tokenish. > > Simpler and faster String >> #withoutLineEndings. > > Precalculate the size of the result in Symbol >> #numArgs: to avoid an extra allocation. > > =============== Diff against Collections-tfel.623 =============== > > Item was changed: > Magnitude subclass: #Character > instanceVariableNames: 'value' > + classVariableNames: 'AlphaNumericMask CharacterTable ClassificationTable DigitBit DigitValues LetterMask LowercaseBit UppercaseBit' > - classVariableNames: 'CharacterTable ClassificationTable DigitValues LetterBits LowercaseBit UppercaseBit' > poolDictionaries: '' > category: 'Collections-Strings'! > > !Character commentStamp: 'ar 4/9/2005 22:35' prior: 0! > I represent a character by storing its associated Unicode. The first 256 characters are created uniquely, so that all instances of latin1 characters ($R, for example) are identical. > > The code point is based on Unicode. Since Unicode is 21-bit wide character set, we have several bits available for other information. As the Unicode Standard states, a Unicode code point doesn't carry the language information. This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean. Or often CJKV including Vietnamese). Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools. To utilize the extra available bits, we use them for identifying the languages. Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages. > > The other languages can have the language tag if you like. This will help to break the large default font (font set) into separately loadable chunk of fonts. However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false. > > I represent a character by storing its associated ASCII code (extended to 256 codes). My instances are created uniquely, so that all instances of a character ($R, for example) are identical.! > > Item was changed: > ----- Method: Character class>>initializeClassificationTable (in category 'class initialization') ----- > initializeClassificationTable > + "Initialize the classification table. > + The classification table is a compact encoding of upper and lower cases and digits of characters with > + - bits 0-7: The lower case value of this character or 0, if its greater than 255. > + - bits 8-15: The upper case value of this character or 0, if its greater than 255. > + - bit 16: lowercase bit (isLowercase == true) > + - bit 17: uppercase bit (isUppercase == true) > + - bit 18: digit bit (isDigit == true)" > + " self initializeClassificationTable " > - " > - Initialize the classification table. The classification table is a > - compact encoding of upper and lower cases of characters with > > + | encodedCharSet | > + "Base the table on the EncodedCharset of these characters' leadingChar - 0." > + encodedCharSet := EncodedCharSet charsetAt: 0. > - - bits 0-7: The lower case value of this character. > - - bits 8-15: The upper case value of this character. > - - bit 16: lowercase bit (e.g., isLowercase == true) > - - bit 17: uppercase bit (e.g., isUppercase == true) > > - " > - | ch1 | > - > LowercaseBit := 1 bitShift: 16. > UppercaseBit := 1 bitShift: 17. > + DigitBit := 1 bitShift: 18. > > + "Initialize the letter mask (e.g., isLetter == true)" > + LetterMask := LowercaseBit bitOr: UppercaseBit. > - "Initialize the letter bits (e.g., isLetter == true)" > - LetterBits := LowercaseBit bitOr: UppercaseBit. > > + "Initialize the alphanumeric mask (e.g. isAlphaNumeric == true)" > + AlphaNumericMask := LetterMask bitOr: DigitBit. > - ClassificationTable := Array new: 256. > - "Initialize the defaults (neither lower nor upper case)" > - 0 to: 255 do:[:i| > - ClassificationTable at: i+1 put: (i bitShift: 8) + i. > - ]. > > + "Initialize the table based on encodedCharSet." > + ClassificationTable := Array new: 256. > + 0 to: 255 do: [ :code | > + | isLowercase isUppercase isDigit lowercaseCode uppercaseCode value | > + isLowercase := encodedCharSet isLowercaseCode: code. > + isUppercase := encodedCharSet isUppercaseCode: code. > + isDigit := encodedCharSet isDigitCode: code. > + lowercaseCode := encodedCharSet toLowercaseCode: code. > + lowercaseCode > 255 ifTrue: [ lowercaseCode := 0 ]. > + uppercaseCode := encodedCharSet toUppercaseCode: code. > + uppercaseCode > 255 ifTrue: [ uppercaseCode := 0 ]. > + value := (uppercaseCode bitShift: 8) + lowercaseCode. > + isLowercase ifTrue: [ value := value bitOr: LowercaseBit ]. > + isUppercase ifTrue: [ value := value bitOr: UppercaseBit ]. > + isDigit ifTrue: [ value := value bitOr: DigitBit ]. > + ClassificationTable at: code + 1 put: value ]! > - "Initialize character pairs (upper-lower case)" > - #( > - "Basic roman" > - ($A $a) ($B $b) ($C $c) ($D $d) > - ($E $e) ($F $f) ($G $g) ($H $h) > - ($I $i) ($J $j) ($K $k) ($L $l) > - ($M $m) ($N $n) ($O $o) ($P $p) > - ($Q $q) ($R $r) ($S $s) ($T $t) > - ($U $u) ($V $v) ($W $w) ($X $x) > - ($Y $y) ($Z $z) > - "International" > - ($? $?) ($? $?) ($? $?) ($? $?) > - ($? $?) ($? $?) ($? $?) ($? $?) > - ($? $?) ($? $?) ($? $?) ($? $?) > - "International - Spanish" > - ($? $?) ($? $?) ($? $?) ($? $?) > - "International - PLEASE CHECK" > - ($? $?) ($? $?) ($? $?) ($? $?) > - ($? $?) ($? $?) > - ($? $?) ($? $?) ($? $?) ($? $?) ($? $?) > - ) do:[:pair| | ch2 | > - ch1 := pair first asciiValue. > - ch2 := pair last asciiValue. > - ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch2 + UppercaseBit. > - ClassificationTable at: ch2+1 put: (ch1 bitShift: 8) + ch2 + LowercaseBit. > - ]. > - > - "Initialize a few others for which we only have lower case versions." > - #($? $? $? $?) do:[:char| > - ch1 := char asciiValue. > - ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch1 + LowercaseBit. > - ]. > - ! > > Item was changed: > ----- Method: Character>>encodedCharSet (in category 'accessing') ----- > encodedCharSet > + > + value < 16r400000 ifTrue: [ ^Unicode ]. "Shortcut" > - > ^EncodedCharSet charsetAt: self leadingChar > ! > > Item was changed: > ----- Method: Character>>tokenish (in category 'testing') ----- > tokenish > + "Answer whether the receiver is a valid token-character--letter, digit, or colon." > - "Answer whether the receiver is a valid token-character--letter, digit, or > - colon." > > + self == $_ ifTrue: [ ^Scanner prefAllowUnderscoreSelectors ]. > + ^self == $: or: [ self isAlphaNumeric ]! > - ^ self == $_ > - ifTrue: [ Scanner prefAllowUnderscoreSelectors ] > - ifFalse: [ self == $: or: [ self isLetter or: [ self isDigit ] ] ]! > > Item was changed: > ----- Method: String>>withoutLineEndings (in category 'converting') ----- > withoutLineEndings > > + ^self withLineEndings: ' '! > - ^ self withSqueakLineEndings > - copyReplaceAll: String cr > - with: ' ' > - asTokens: false! > > Item was changed: > ----- Method: Symbol>>numArgs: (in category 'system primitives') ----- > numArgs: n > "Answer a string that can be used as a selector with n arguments. > TODO: need to be extended to support shrinking and for selectors like #+ " > > + | numArgs offset |. > + (numArgs := self numArgs) >= n ifTrue: [ ^self ]. > + numArgs = 0 > + ifTrue: [ offset := 1 ] > + ifFalse: [ offset := 0 ]. > + ^(String new: n - numArgs + offset * 5 + offset + self size streamContents: [ :stream | > + stream nextPutAll: self. > + numArgs = 0 ifTrue: [ stream nextPut: $:. ]. > + numArgs + offset + 1 to: n do: [ :i | stream nextPutAll: 'with:' ] ]) asSymbol! > - | numArgs aStream offs |. > - (numArgs := self numArgs) >= n ifTrue: [^self]. > - aStream := WriteStream on: (String new: 16). > - aStream nextPutAll: self. > - > - (numArgs = 0) ifTrue: [aStream nextPutAll: ':'. offs := 0] ifFalse: [offs := 1]. > - 2 to: n - numArgs + offs do: [:i | aStream nextPutAll: 'with:']. > - ^aStream contents asSymbol! > > Item was changed: > + (PackageInfo named: 'Collections') postscript: 'Character initializeClassificationTable'! > - (PackageInfo named: 'Collections') postscript: 'LRUCache allInstances do: [ :each | each reset ]'! > > >

2 1

Font handling
by karl ramberg 02 May '15

02 May '15

Hi, the current font handling could need a refactoring/ cleanup. Emphasis of a font are stored in different places and that makes it inconsistent and very hard to interface. As far as I can tell should the emphasis info be stored as a text attribute. But it seems that many tools set the emphasis directly in the font. Here is a couple of examples from text in Workspaces: {a TextEmphasis code: 1 . aTextFontReference(TTCFont(BitstreamVeraSansMono 24 Bold Oblique))} This font has bold and italics set in the font (corresponds to value 3), but the emphasis attribute is 1 which corresponds to bold. {a TextFontReference(a StrikeFont(Accumon10 12))} Here is also emphasis set in the font and no emphasis attribute is present at all. Karl

1 1

Daily Commit Log
by commits＠source.squeak.org 01 May '15

01 May '15

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2015-April/008190.html Name: Collections-nice.622 Ancestors: Collections-mt.621 #toBraceStack: is not used for compiling { } for so long that it's really time to get rid of it. Symbol>>numArgs: does not need to copy self into a temp var. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-April/008191.html Name: GetText-nice.36 Ancestors: GetText-kfr.35 Though it can't really be tested in current trunk image state (InternalTranslator is not initialized) , modernize the way to utf8+gzip+base64 encode... This how how simpler the world could be without those Multi RW Binary or Text things, no need to send those reset/ascii/binary incantations. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008192.html Name: CollectionsTests-tfel.240 Ancestors: CollectionsTests-mt.239 Add a test case to check that ByteString>>findSubstring:in:startingAt:matchTable: behaves the same way as the primitive implementation (esp when using a negative index for startingAt:) ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008193.html Name: Collections-tfel.623 Ancestors: Collections-nice.622 fix fallback code for ByteString>>findSubstring:in:startingAt:matchTable: when passing a starting index <= 0 ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008194.html Name: Morphic-mt.953 Ancestors: Morphic-mt.952 Text editor hooks modified to be more descriptive on model side. And to not confuse Tweak. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008195.html Name: MorphicTests-mt.29 Ancestors: MorphicTests-mt.28 Tests added for text editor's model callbacks. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008196.html Name: EToys-mt.124 Ancestors: EToys-topa.123 Tiles-view check moved from Tools package. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008197.html Name: MorphicExtras-mt.162 Ancestors: MorphicExtras-mt.161 Added from Morph package. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008198.html Name: Morphic-mt.954 Ancestors: Morphic-mt.953 Deprecations updated and some dependencies to MorphicExtras removed. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008199.html Name: Tools-mt.613 Ancestors: Tools-mt.612 Deprecations updated. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008200.html Name: 46Deprecated-mt.1 Ancestors: Some deprecations for 4.6 added. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008201.html Name: Kernel-nice.921 Ancestors: Kernel-topa.920 Provide an exact version for #floorLog: for those Number using exact arithmetic (as proposed in inbox Kernel-nice.721 / 11 December 2012). Previous version was not exact, otherwise this count would have been zero: (-300 to: -1) count: [:n | n ~= ((10 raisedTo: n) floorLog: 10)]. Note that this won't make #log: exact, and could lead to disagreement between the two functions. However, old behavior compatible with log: is still possible by passing the radix argument asFloat, so this is not a real problem. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008202.html Name: KernelTests-nice.293 Ancestors: KernelTests-mt.292 Tests asserting floorLog: exactness for Number performing exact arithmetic. This was inbox KernelTests-nice.239 / 11 December 2012 ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008203.html Name: Kernel-nice.922 Ancestors: Kernel-nice.921 Remove an un-necessary inst. var. shadowing (inbox Kernel-nice.745 7 March 2013) ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008204.html Name: Kernel-nice.923 Ancestors: Kernel-nice.922 Use an intermediate abstract Float representation (sign, exponent, significand) in order to convert single precision bits to double precision bits rather than attempting the conversion by direct bit manipulations. This lead to simpler code, because it is like a semantic bit manipulation rather than a raw bit manipulation. And this also lead to faster code on 32 bits interpreter/COG/Spur VM thanks to avoidance of LargeInteger (was Kernel-nice.893 / 24 December 2014) ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008205.html Name: Collections-tfel.624 Ancestors: Collections-tfel.623 remove overrides for beginsWith: in ByteStrings and ByteSymbols, because these actually perform worse now than the generic implementation in String ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008206.html Name: Collections-mt.625 Ancestors: Collections-tfel.624 Speed-up #endsWith: for strings. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008207.html Name: Morphic-mt.955 Ancestors: Morphic-mt.954 Flag about a performance issue in scroll bars added. We should improve that at some point. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008208.html Name: Tools-mt.614 Ancestors: Tools-mt.613 Some descriptive balloon texts added to browser's switch buttons. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008209.html Name: SMLoader-mt.82 Ancestors: SMLoader-cmm.81 Fixed layout problems and selection bugs in SqueakMap tools. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008210.html Name: Tools-mt.615 Ancestors: Tools-mt.614 Use code panes in inspector and object explorer (was text panes). ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008211.html Name: ShoutCore-ul.46 Ancestors: ShoutCore-ul.45 SHParserST80 performance improvements: - store the allowUnderscoreAssignments and allowUnderscoreSelectors preferences in instance variables - don't honor per class allowUnderscoreAssignments preferences anymore (just like how allowUnderscoreSelectors works) - ensure that instanceVariables is always an Array - reordered branches in some methods based on the methods of the Morph class as sample - use quick returns in frequently used testing methods - release the errorBlock in #parse, instead of an #ensure: block in #parse: - decreased the initial size of ranges to 40 - use Symbol >> #lookup: instead of Symbol >> #hasInterned:ifTrue: - use the fact that classOrMetaClass is nil when it's not a Behavior - use a fast primitive in #scanComment instead of a loop ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008212.html Name: ShoutCore-ul.47 Ancestors: ShoutCore-ul.46 Removed encodedCharSet from SHParserST80. All methods referencing it are sending the corresponding method to the character again. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008213.html Name: Collections-mt.626 Ancestors: Collections-mt.625 Added the (configurable) possibility to disable forced transcript updates as well as to enable a generic redirection to stdout. Only works when using the #show: or #showln: interface in Transcript. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008214.html Name: ST80-mt.183 Ancestors: ST80-dtl.182 Some assumptions on model interface removed. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2015-May/008215.html Name: Morphic-mt.956 Ancestors: Morphic-mt.955 Some assumptions on model interface removed from text fields. Missing #appendEntryLater added to text fields, which is needed for deferred transcript updates. =============================================

1 0

The Trunk: Morphic-mt.956.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.956.mcz ==================== Summary ==================== Name: Morphic-mt.956 Author: mt Time: 1 May 2015, 8:52:04.62 pm UUID: 9c194491-b261-5b4b-8e79-9806c257dc69 Ancestors: Morphic-mt.955 Some assumptions on model interface removed from text fields. Missing #appendEntryLater added to text fields, which is needed for deferred transcript updates. =============== Diff against Morphic-mt.955 =============== Item was changed: ----- Method: PluggableTextMorph>>promptForCancel (in category 'unaccepted edits') ----- promptForCancel "Ask if it is OK to cancel changes to text" (self confirm: 'Changes have not been saved. Is it OK to cancel those changes?' translated) + ifTrue: [model changed: #clearUserEdits]. - ifTrue: [model clearUserEditFlag]. ! Item was changed: ----- Method: PluggableTextMorph>>update: (in category 'updating') ----- update: aSymbol aSymbol ifNil: [^self]. aSymbol == #flash ifTrue: [^self flash]. aSymbol == getTextSelector ifTrue: [ self setText: self getText. getSelectionSelector ifNotNil: [self setSelection: self getSelection]. ^ self]. aSymbol == getSelectionSelector ifTrue: [^self setSelection: self getSelection]. (aSymbol == #autoSelect and: [getSelectionSelector notNil]) ifTrue: [self handleEdit: [(textMorph editor) abandonChangeText; "no replacement!!" setSearch: model autoSelectString; againOrSame: true]]. aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false]. aSymbol == #wantToChange ifTrue: [self canDiscardEdits ifFalse: [^self promptForCancel]. ^self]. aSymbol == #appendEntry ifTrue: [self handleEdit: [self appendEntry]. ^self refreshWorld]. + aSymbol == #appendEntryLater + ifTrue: [self handleEdit: [self appendEntry]]. aSymbol == #clearText ifTrue: [self handleEdit: [self changeText: Text new]. ^self refreshWorld]. aSymbol == #bs ifTrue: [self handleEdit: [self bsText]. ^self refreshWorld]. aSymbol == #codeChangedElsewhere ifTrue: [self hasEditingConflicts: true. ^self changed]. aSymbol == #saveContents ifTrue: [^self saveContentsInFile]!

1 0

The Trunk: ST80-mt.183.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-mt.183.mcz ==================== Summary ==================== Name: ST80-mt.183 Author: mt Time: 1 May 2015, 8:49:18.781 pm UUID: 2a9e776d-332f-1745-b070-49786b01e8b7 Ancestors: ST80-dtl.182 Some assumptions on model interface removed. =============== Diff against ST80-dtl.182 =============== Item was changed: ----- Method: StringHolderController>>userHasNotEdited (in category 'edit flag') ----- userHasNotEdited "Note that my text is free of user edits." + model changed: #clearUserEdits.! - model clearUserEditFlag - ! Item was changed: ----- Method: StringHolderView>>promptForCancel (in category 'updating') ----- promptForCancel "Ask if it is OK to cancel changes to text" | okToCancel stripes | self topView isCollapsed ifTrue: [(self confirm: 'Changes have not been saved. + Is it OK to cancel those changes?' translated) ifTrue: [model changed: #clearUserEdits]. - Is it OK to cancel those changes?' translated) ifTrue: [model clearUserEditFlag]. ^ self]. stripes := (Form extent: 16@16 fromStipple: 16r36C9) bits. Display border: self insetDisplayBox width: 4 rule: Form reverse fillColor: stripes. okToCancel := self confirm: 'Changes have not been saved. Is it OK to cancel those changes?' translated. Display border: self insetDisplayBox width: 4 rule: Form reverse fillColor: stripes. okToCancel ifTrue: [self updateDisplayContents. + model changed: #clearUserEdits]. - model clearUserEditFlag]. !

1 0

The Trunk: Collections-mt.626.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.626.mcz ==================== Summary ==================== Name: Collections-mt.626 Author: mt Time: 1 May 2015, 8:10:29.695 pm UUID: e8f27fe3-f480-8244-92bb-a23d8f61fd20 Ancestors: Collections-mt.625 Added the (configurable) possibility to disable forced transcript updates as well as to enable a generic redirection to stdout. Only works when using the #show: or #showln: interface in Transcript. =============== Diff against Collections-mt.625 =============== Item was changed: WriteStream subclass: #TranscriptStream instanceVariableNames: 'lastChar' + classVariableNames: 'AccessSema ForceUpdate RedirectToStdOut' - classVariableNames: 'AccessSema' poolDictionaries: '' category: 'Collections-Streams'! !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' prior: 0! This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic. Because it inherits from Stream, it is automatically compatible with code that is designed to write to streams.! Item was added: + ----- Method: TranscriptStream class>>forceUpdate (in category 'preferences') ----- + forceUpdate + + <preference: 'Force transcript updates to screen' + categoryList: #(printing morphic debug) + description: 'When enabled, transcript updates will immediately shown in the screen no matter how busy the UI process is.' + type: #Boolean> + ^ ForceUpdate ifNil: [true]! Item was added: + ----- Method: TranscriptStream class>>forceUpdate: (in category 'preferences') ----- + forceUpdate: aBoolean + + ForceUpdate := aBoolean.! Item was changed: + ----- Method: TranscriptStream class>>new (in category 'instance creation') ----- - ----- Method: TranscriptStream class>>new (in category 'as yet unclassified') ----- new ^ self on: (String new: 1000) " INSTALLING: TextCollector allInstances do: [:t | t breakDependents. t become: TranscriptStream new]. TESTING: (Execute this text in a workspace) Do this first... tt := TranscriptStream new. tt openLabel: 'Transcript test 1'. Then this will open a second view -- ooooh... tt openLabel: 'Transcript test 2'. And finally make them do something... tt clear. [Sensor anyButtonPressed] whileFalse: [1 to: 20 do: [:i | tt print: (2 raisedTo: i-1); cr; endEntry]]. "! Item was changed: + ----- Method: TranscriptStream class>>newTranscript: (in category 'instance creation') ----- - ----- Method: TranscriptStream class>>newTranscript: (in category 'as yet unclassified') ----- newTranscript: aTextCollector "Store aTextCollector as the value of the system global Transcript." Smalltalk at: #Transcript put: aTextCollector! Item was added: + ----- Method: TranscriptStream class>>redirectToStdOut (in category 'preferences') ----- + redirectToStdOut + <preference: 'Redirect transcript to stdout' + categoryList: #(printing morphic debug) + description: 'When enabled, no Morphic is needed when using the transcript interface to debug.' + type: #Boolean> + ^ RedirectToStdOut ifNil: [false]! Item was added: + ----- Method: TranscriptStream class>>redirectToStdOut: (in category 'preferences') ----- + redirectToStdOut: aBoolean + + RedirectToStdOut := aBoolean.! Item was changed: ----- Method: TranscriptStream>>endEntry (in category 'stream extensions') ----- endEntry "Display all the characters since the last endEntry, and reset the stream" self semaphore critical:[ + self class forceUpdate + ifTrue: [self changed: #appendEntry] + ifFalse: [self changed: #appendEntryLater]. - self changed: #appendEntry. self reset. ].! Item was changed: ----- Method: TranscriptStream>>show: (in category 'stream extensions') ----- + show: anObject + "TextCollector compatibility" + + [ + self target nextPutAll: anObject asString. + self endEntry + ] on: FileWriteError do: [self class redirectToStdOut: false].! - show: anObject "TextCollector compatibility" - self nextPutAll: anObject asString; endEntry! Item was changed: ----- Method: TranscriptStream>>showln: (in category 'stream extensions') ----- + showln: anObject + "TextCollector compatibility. Ensure a new line before inserting a message." + + [ + self target + cr; + nextPutAll: anObject asString. + self endEntry. + ] on: FileWriteError do: [self class redirectToStdOut: false].! - showln: anObject "TextCollector compatibility" - self nextPutAll: anObject asString; cr ; endEntry! Item was added: + ----- Method: TranscriptStream>>target (in category 'stream extensions') ----- + target + + ^ self class redirectToStdOut + ifTrue: [FileStream stdout] + ifFalse: [self]!

1 0

The Trunk: ShoutCore-ul.47.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Levente Uzonyi uploaded a new version of ShoutCore to project The Trunk: http://source.squeak.org/trunk/ShoutCore-ul.47.mcz ==================== Summary ==================== Name: ShoutCore-ul.47 Author: ul Time: 1 May 2015, 1:52:05.9 pm UUID: a4a03a3c-da8f-4e81-86f5-09b950cfeabe Ancestors: ShoutCore-ul.46 Removed encodedCharSet from SHParserST80. All methods referencing it are sending the corresponding method to the character again. =============== Diff against ShoutCore-ul.46 =============== Item was changed: Object subclass: #SHParserST80 + instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition blockDepth bracketDepth ranges environment allowUnderscoreAssignments allowUnderscoreSelectors' - instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition blockDepth bracketDepth ranges environment encodedCharSet allowUnderscoreAssignments allowUnderscoreSelectors' classVariableNames: '' poolDictionaries: '' category: 'ShoutCore-Parsing'! !SHParserST80 commentStamp: 'tween 8/16/2004 15:44' prior: 0! I am a Smalltalk method / expression parser. Rather than creating an Abstract Syntax Tree, I create a sequence of SHRanges (in my 'ranges' instance variable), which represent the tokens within the String I am parsing. I am used by a SHTextStylerST80 to parse method source strings. I am able to parse incomplete / incorrect methods, and so can be used to parse methods that are being edited. My 'source' instance variable should be set to the string to be parsed. My 'classOrMetaClass' instance var must be set to the class or metaClass for the method source so that I can correctly resolve identifiers within the source. If this is nil , I parse the source as an expression (i.e. a doIt expression). My 'workspace' instance variable can be set to a Workspace, so that I can resolve workspace variables. My 'environment' instance variable is the global namespace (this is initialized to Smalltalk, but can be set to a different environment). Example 1. ranges := SHParserST80 new classOrMetaClass: Object; source: 'testMethod ^self'; parse; ranges ! Item was changed: ----- Method: SHParserST80>>isKeyword (in category 'token testing') ----- isKeyword "This method assumes that currentTokenFirst is a non-letter character when currentToken is nil." + currentTokenFirst isLetter ifTrue: [ - (encodedCharSet isLetter: currentTokenFirst) ifTrue: [ ^currentToken last == $: ]. ^allowUnderscoreSelectors and: [ currentTokenFirst == $_ and: [ currentToken notNil and: [ currentToken size > 1 and: [ currentToken last == $: ] ] ] ]! Item was changed: ----- Method: SHParserST80>>isName (in category 'token testing') ----- isName "This method assumes that currentTokenFirst is a non-letter character when currentToken is nil." + ^(currentTokenFirst isLetter - ^((encodedCharSet isLetter: currentTokenFirst) or: [ allowUnderscoreSelectors and: [ currentTokenFirst == $_ and: [ currentToken notNil and: [ currentToken size > 1 ] ] ] ]) + and: [ currentToken last isAlphaNumeric - and: [ (encodedCharSet isAlphaNumeric: currentToken last) or: [ allowUnderscoreSelectors and: [ currentToken last == $_ ] ] ] ! Item was changed: ----- Method: SHParserST80>>isSelectorCharacter: (in category 'character testing') ----- isSelectorCharacter: aCharacter | asciiValue | ('"#$'':().;[]{}^_' includes: aCharacter) ifTrue: [ ^false ]. aCharacter isSeparator ifTrue:[ ^false ]. + aCharacter isAlphaNumeric ifTrue: [ ^false ]. - (encodedCharSet isAlphaNumeric: aCharacter) ifTrue: [ ^false ]. (asciiValue := aCharacter asciiValue) = 30 ifTrue: [ ^false "the doIt char" ]. ^asciiValue ~= 0 "Any other char, but 0 is ok as a binary selector char." ! Item was changed: ----- Method: SHParserST80>>parseByteArray (in category 'parse') ----- parseByteArray + [currentTokenFirst == $]] whileFalse: [ + currentTokenFirst isDigit - (encodedCharSet isDigit: currentTokenFirst) ifTrue: [ "do not parse the number, can be time consuming" self scanPast: #number] ifFalse: [ self failWhen: currentTokenFirst == $. . self error]]. self scanPast: #byteArrayEnd! Item was changed: ----- Method: SHParserST80>>parseExternalCall (in category 'parse') ----- parseExternalCall [self scanNext. ((Smalltalk at: #ExternalFunction) callingConventionModifierFor: currentToken) notNil] whileTrue. self failUnless: currentToken notNil. self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]. + currentTokenFirst isDigit - (encodedCharSet isDigit: currentTokenFirst) ifTrue: [self scanPast: #integer] ifFalse: [ self failUnless: currentTokenFirst == $'. self parseString]. self failUnless: currentTokenFirst == $(. self scanPast: #leftParenthesis. [currentTokenFirst ~= $)] whileTrue: [ self failUnless: currentToken notNil. self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]]. self scanPast: #rightParenthesis. currentToken = 'module:' ifTrue: [ self scanPast: #module. self parseStringOrSymbol ]. currentToken = 'error:' ifTrue: [ self scanPast: #primitive. "there's no rangeType for error" self isName ifTrue: [ self scanPast: #patternTempVar ] ifFalse: [ self parseStringOrSymbol ] ]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! Item was changed: ----- Method: SHParserST80>>parseLiteral: (in category 'parse') ----- + parseLiteral: inArray + - parseLiteral: inArray currentTokenFirst == $$ ifTrue: [ | pos | self failWhen: self currentChar isNil. self rangeType: #'$'. pos := currentTokenSourcePosition + 1. self nextChar. ^self scanPast: #character start: pos end: pos]. + currentTokenFirst isDigit - (encodedCharSet isDigit: currentTokenFirst) ifTrue: [ "do not parse the number, can be time consuming" ^self scanPast: #number]. currentToken = '-' ifTrue: [ | c | c := self currentChar. + (inArray and: [c isNil or: [ c isDigit not ]]) - (inArray and: [c isNil or: [(encodedCharSet isDigit: c) not]]) ifTrue: [ "single - can be a symbol in an Array" ^self scanPast: #symbol]. self scanPast: #-. self failWhen: currentToken isNil. "token isNil ifTrue: [self error: 'Unexpected End Of Input']." "do not parse the number, can be time consuming" ^self scanPast: #number]. currentTokenFirst == $' ifTrue: [^self parseString]. currentTokenFirst == $# ifTrue: [^self parseSymbol]. (inArray and: [currentToken notNil]) ifTrue: [^self scanPast: #symbol]. self failWhen: currentTokenFirst == $. . self error ": 'argument missing'"! Item was changed: ----- Method: SHParserST80>>parseLiteralArrayElement (in category 'parse') ----- parseLiteralArrayElement + + currentTokenFirst isLetter ifTrue: [ + #true = currentToken ifTrue: [ ^self scanPast: #true ]. + #false = currentToken ifTrue: [ ^self scanPast: #false ]. + #nil = currentToken ifTrue: [ ^self scanPast: #nil ]. + ^self scanPast: #symbol ]. + currentTokenFirst == $( ifTrue: [ + self scanPast: #arrayStart. + ^self parseArray ]. - (encodedCharSet isLetter: currentTokenFirst) - ifTrue: [ - #true = currentToken ifTrue: [ ^self scanPast: #true ]. - #false = currentToken ifTrue: [ ^self scanPast: #false ]. - #nil = currentToken ifTrue: [ ^self scanPast: #nil ]. - ^self scanPast: #symbol ]. - currentTokenFirst == $( - ifTrue: [ - self scanPast: #arrayStart. - ^self parseArray]. ^self parseLiteral: true! Item was changed: ----- Method: SHParserST80>>parsePrimitive (in category 'parse') ----- parsePrimitive self scanNext. + currentTokenFirst isDigit - (encodedCharSet isDigit: currentTokenFirst) ifTrue: [ self scanPast: #integer ] ifFalse: [ self parseStringOrSymbol. currentToken = 'module:' ifTrue: [ self scanPast: #module. self parseStringOrSymbol ] ]. currentToken = 'error:' ifTrue: [ self scanPast: #primitive. "there's no rangeType for error" self isName ifTrue: [ self scanPast: #patternTempVar ] ifFalse: [ self parseStringOrSymbol ] ]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! Item was changed: ----- Method: SHParserST80>>parseSymbol (in category 'parse') ----- parseSymbol | c | currentToken = '#' ifTrue: [ "if token is just the #, then scan whitespace and comments and then process the next character. Squeak allows space between the # and the start of the symbol e.g. # (), # a, # 'sym' " self rangeType: #symbol. self scanWhitespace]. c := self currentChar. self failWhen: (c isNil or: [c isSeparator]). c == $( ifTrue: [ self nextChar. self scanPast: #arrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1. ^self parseArray]. c == $' ifTrue: [^self parseSymbolString]. c == $[ ifTrue: [ self nextChar. self scanPast: #byteArrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1. ^self parseByteArray]. ((self isSelectorCharacter: c) or: [c == $-]) ifTrue: [^self parseSymbolSelector]. + (c isLetter - ((encodedCharSet isLetter: c) or: [ c == $: or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ]) ifTrue: [^self parseSymbolIdentifier]. ^self parseCharSymbol! Item was changed: ----- Method: SHParserST80>>parseSymbolIdentifier (in category 'parse') ----- parseSymbolIdentifier | c start end | c := self currentChar. self failUnless: ( + c isLetter - (encodedCharSet isLetter: c) or: [ c == $: or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ]). start := sourcePosition. [ + (c := self nextChar) isAlphaNumeric - c := self nextChar. - (encodedCharSet isAlphaNumeric: c) or: [ c == $: + or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ] ] whileTrue. - or: [ allowUnderscoreSelectors and: [ c == $_] ] ] ] whileTrue. end := sourcePosition - 1. c := source copyFrom: start - 1 to: end. self scanPast: #symbol start: start - 1 end: end. ^c! Item was changed: ----- Method: SHParserST80>>scanIdentifier (in category 'scan') ----- scanIdentifier | c start | start := sourcePosition. [ + (c := self nextChar) isAlphaNumeric - (encodedCharSet isAlphaNumeric: (c := self nextChar)) or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ] whileTrue. (c == $: and: [ (self isSelectorCharacter: self peekChar) not ]) ifTrue: [ self nextChar ]. currentToken := source copyFrom: start to: sourcePosition - 1. currentTokenSourcePosition := start! Item was changed: ----- Method: SHParserST80>>scanNext (in category 'scan') ----- scanNext self scanWhitespace. currentTokenFirst := self currentChar ifNil: [ " end of input " currentTokenFirst := $ . currentTokenSourcePosition := nil. currentToken := nil. ^nil ]. + currentTokenFirst isDigit ifTrue: [ ^self scanNumber ]. + (currentTokenFirst isLetter or: [ - (encodedCharSet isDigit: currentTokenFirst) ifTrue: [ ^self scanNumber ]. - ((encodedCharSet isLetter: currentTokenFirst) or: [ allowUnderscoreSelectors and: [ currentTokenFirst == $_ ] ]) ifTrue: [ ^self scanIdentifier ]. ^self scanBinary! Item was changed: ----- Method: SHParserST80>>scanNumber (in category 'scan') ----- scanNumber | start c nc base | start := sourcePosition. self skipDigits. c := self currentChar. c == $r ifTrue: [ base := Integer readFrom: (ReadStream on: (source copyFrom: start to: sourcePosition - 1)). self peekChar == $- ifTrue:[self nextChar]. self skipBigDigits: base. c := self currentChar. c == $. ifTrue: [ (self isBigDigit: self nextChar base: base) ifFalse: [sourcePosition := sourcePosition - 1] ifTrue: [self skipBigDigits: base]]. c := self currentChar. ('deq'includes: c) ifTrue: [ + ((nc := self nextChar) isDigit or: [nc == $- and: [ self peekChar isDigit ]]) - ((encodedCharSet isDigit: (nc := self nextChar)) or: [nc == $- and:[(encodedCharSet isDigit: self peekChar)]]) ifFalse: [sourcePosition := sourcePosition - 1] ifTrue: [self skipDigits]]. c == $s ifTrue: [ + (nc := self nextChar) isDigit - (encodedCharSet isDigit: (nc := self nextChar)) ifTrue: [ self skipDigits ] ifFalse: [ + nc isLetter ifTrue: [ - (encodedCharSet isLetter: nc) ifTrue: [ sourcePosition := sourcePosition - 1 ] ] ]. currentToken := source copyFrom: start to: sourcePosition - 1. ^currentTokenSourcePosition := start]. c == $s ifTrue: [ + (nc := self nextChar) isDigit - (encodedCharSet isDigit: (nc := self nextChar)) ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]] ifTrue: [self skipDigits.]. currentToken := source copyFrom: start to: sourcePosition - 1. ^currentTokenSourcePosition := start]. c == $. ifTrue: [ + self nextChar isDigit - (encodedCharSet isDigit: self nextChar) ifFalse: [ sourcePosition := sourcePosition - 1. currentToken := source copyFrom: start to: sourcePosition - 1. ^currentTokenSourcePosition := start] ifTrue: [self skipDigits]]. c := self currentChar. ('deq' includes: c) ifTrue: [ + ((nc := self nextChar) isDigit or: [nc == $- and:[ self peekChar isDigit ]]) - ((encodedCharSet isDigit: (nc := self nextChar)) or: [nc == $- and:[(encodedCharSet isDigit: self peekChar)]]) ifFalse: [sourcePosition := sourcePosition - 1] ifTrue: [self skipDigits]]. c == $s ifTrue: [ + (nc := self nextChar) isDigit - (encodedCharSet isDigit: (nc := self nextChar)) ifFalse: [nc isLetter ifTrue: [sourcePosition := sourcePosition - 1]] ifTrue: [self skipDigits]]. currentToken := source copyFrom: start to: sourcePosition - 1. ^currentTokenSourcePosition := start! Item was changed: ----- Method: SHParserST80>>skipDigits (in category 'scan') ----- skipDigits + [ self nextChar isDigit ] whileTrue! - [ (encodedCharSet isDigit: self nextChar) ] whileTrue! Item was changed: ----- Method: SHParserST80>>source: (in category 'accessing') ----- source: aString + source := aString - source := aString. - encodedCharSet := (source at: 1 ifAbsent: [ $0 ]) encodedCharSet !

1 0

The Trunk: ShoutCore-ul.46.mcz
by commits＠source.squeak.org 01 May '15

01 May '15

Levente Uzonyi uploaded a new version of ShoutCore to project The Trunk: http://source.squeak.org/trunk/ShoutCore-ul.46.mcz ==================== Summary ==================== Name: ShoutCore-ul.46 Author: ul Time: 26 April 2015, 8:28:25.9 pm UUID: d9c495e9-2e94-4c74-bc7c-8ff1448d0afd Ancestors: ShoutCore-ul.45 SHParserST80 performance improvements: - store the allowUnderscoreAssignments and allowUnderscoreSelectors preferences in instance variables - don't honor per class allowUnderscoreAssignments preferences anymore (just like how allowUnderscoreSelectors works) - ensure that instanceVariables is always an Array - reordered branches in some methods based on the methods of the Morph class as sample - use quick returns in frequently used testing methods - release the errorBlock in #parse, instead of an #ensure: block in #parse: - decreased the initial size of ranges to 40 - use Symbol >> #lookup: instead of Symbol >> #hasInterned:ifTrue: - use the fact that classOrMetaClass is nil when it's not a Behavior - use a fast primitive in #scanComment instead of a loop =============== Diff against ShoutCore-ul.45 =============== Item was changed: Object subclass: #SHParserST80 + instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition blockDepth bracketDepth ranges environment encodedCharSet allowUnderscoreAssignments allowUnderscoreSelectors' - instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition blockDepth bracketDepth ranges environment encodedCharSet' classVariableNames: '' poolDictionaries: '' category: 'ShoutCore-Parsing'! !SHParserST80 commentStamp: 'tween 8/16/2004 15:44' prior: 0! I am a Smalltalk method / expression parser. Rather than creating an Abstract Syntax Tree, I create a sequence of SHRanges (in my 'ranges' instance variable), which represent the tokens within the String I am parsing. I am used by a SHTextStylerST80 to parse method source strings. I am able to parse incomplete / incorrect methods, and so can be used to parse methods that are being edited. My 'source' instance variable should be set to the string to be parsed. My 'classOrMetaClass' instance var must be set to the class or metaClass for the method source so that I can correctly resolve identifiers within the source. If this is nil , I parse the source as an expression (i.e. a doIt expression). My 'workspace' instance variable can be set to a Workspace, so that I can resolve workspace variables. My 'environment' instance variable is the global namespace (this is initialized to Smalltalk, but can be set to a different environment). Example 1. ranges := SHParserST80 new classOrMetaClass: Object; source: 'testMethod ^self'; parse; ranges ! Item was removed: - ----- Method: SHParserST80>>allowUnderscoreAssignments (in category 'private') ----- - allowUnderscoreAssignments - "Query class + preference" - ^(classOrMetaClass ifNotNil: [:c | c allowUnderscoreAssignments]) - ifNil: [Scanner allowUnderscoreAsAssignment ]! Item was removed: - ----- Method: SHParserST80>>allowUnderscoreSelectors (in category 'private') ----- - allowUnderscoreSelectors - ^ Scanner prefAllowUnderscoreSelectors! Item was changed: ----- Method: SHParserST80>>initializeInstanceVariables (in category 'parse support') ----- initializeInstanceVariables + + instanceVariables := classOrMetaClass + ifNil: [ #() ] + ifNotNil: [ classOrMetaClass allInstVarNames asArray ]! - instanceVariables := classOrMetaClass notNil - ifTrue: [classOrMetaClass allInstVarNames asArray] - ifFalse: [Set new]! Item was changed: ----- Method: SHParserST80>>isAssignment (in category 'token testing') ----- isAssignment + + self isAnsiAssignment ifTrue: [ ^true ]. + ^allowUnderscoreAssignments and: [ currentToken = '_' ]! - ^self isAnsiAssignment or: [self allowUnderscoreAssignments and: [currentToken = '_']]! Item was changed: ----- Method: SHParserST80>>isBinary (in category 'token testing') ----- isBinary + + currentToken ifNil: [ ^false ]. + self isName ifTrue: [ ^false ]. + self isKeyword ifTrue: [ ^false ]. + 1 to: currentToken size do: [ :i | + (self isSelectorCharacter: (currentToken at: i)) ifFalse: [ ^false ] ]. - (currentToken isNil or: [self isName or: [self isKeyword]]) - ifTrue: [^false]. - 1 to: currentToken size do: [:i | | c | - c := currentToken at: i. - (self isSelectorCharacter: c) - ifFalse: [^false]]. ^true! Item was changed: ----- Method: SHParserST80>>isKeyword (in category 'token testing') ----- isKeyword "This method assumes that currentTokenFirst is a non-letter character when currentToken is nil." + (encodedCharSet isLetter: currentTokenFirst) ifTrue: [ + ^currentToken last == $: ]. + ^allowUnderscoreSelectors + and: [ currentTokenFirst == $_ + and: [ currentToken notNil + and: [ currentToken size > 1 + and: [ currentToken last == $: ] ] ] ]! - ^((encodedCharSet isLetter: currentTokenFirst) or: [ - currentTokenFirst == $_ and: [ - currentToken notNil and: [ - currentToken size > 1 and: [ - self allowUnderscoreSelectors ] ] ] ]) and: [ - currentToken last == $: ]! Item was changed: ----- Method: SHParserST80>>isName (in category 'token testing') ----- isName "This method assumes that currentTokenFirst is a non-letter character when currentToken is nil." ^((encodedCharSet isLetter: currentTokenFirst) + or: [ allowUnderscoreSelectors + and: [ currentTokenFirst == $_ - or: [ currentTokenFirst == $_ and: [ currentToken notNil + and: [ currentToken size > 1 ] ] ] ]) - and: [ currentToken size > 1 - and: [ self allowUnderscoreSelectors ] ] ] ]) and: [ (encodedCharSet isAlphaNumeric: currentToken last) + or: [ allowUnderscoreSelectors + and: [ currentToken last == $_ ] ] ] ! - or: [ currentToken last == $_ - and: [ self allowUnderscoreSelectors ] ] ] ! Item was changed: ----- Method: SHParserST80>>isSelectorCharacter: (in category 'character testing') ----- isSelectorCharacter: aCharacter + | asciiValue | + ('"#$'':().;[]{}^_' includes: aCharacter) ifTrue: [ ^false ]. + aCharacter isSeparator ifTrue:[ ^false ]. + (encodedCharSet isAlphaNumeric: aCharacter) ifTrue: [ ^false ]. + (asciiValue := aCharacter asciiValue) = 30 ifTrue: [ ^false "the doIt char" ]. + ^asciiValue ~= 0 "Any other char, but 0 is ok as a binary selector char." - (encodedCharSet isAlphaNumeric: aCharacter) ifTrue: [^false]. - aCharacter isSeparator ifTrue:[^false]. - ('"#$'':().;[]{}^_' includes: aCharacter) - ifTrue:[^false]. - aCharacter asciiValue = 30 ifTrue: [^false "the doIt char"]. - aCharacter asciiValue = 0 ifTrue: [^false]. - "Any other char is ok as a binary selector char." - ^true ! Item was changed: ----- Method: SHParserST80>>nextChar (in category 'scan') ----- nextChar + + ^source at: (sourcePosition := sourcePosition + 1) ifAbsent: $ ! - sourcePosition := sourcePosition + 1. - ^source at: sourcePosition ifAbsent: $ ! Item was changed: ----- Method: SHParserST80>>parse (in category 'parse') ----- parse + "Parse the receiver's text as a Smalltalk method" - "Parse the receiver's text as a Smalltalk method" + self parse: classOrMetaClass notNil. + errorBlock := nil! - ^self parse: (classOrMetaClass notNil) ! Item was changed: ----- Method: SHParserST80>>parse: (in category 'parse') ----- parse: isAMethod "Parse the receiver's text. If isAMethod is true then treat text as a method, if false as an expression with no message pattern" self initializeInstanceVariables. + allowUnderscoreAssignments := Scanner allowUnderscoreAsAssignment. + allowUnderscoreSelectors := Scanner prefAllowUnderscoreSelectors. sourcePosition := 1. arguments := Dictionary new. temporaries := Dictionary new. blockDepth := bracketDepth := 0. ranges + ifNil: [ ranges := OrderedCollection new: 40 "Covers over 80% of all methods." ] + ifNotNil: [ ranges reset ]. - ifNil: [ranges := OrderedCollection new: 100] - ifNotNil: [ranges reset]. errorBlock := [^false]. + self scanNext. + isAMethod ifTrue: [ + self + parseMessagePattern; + parsePragmaSequence ]. - [self scanNext. - isAMethod - ifTrue: [ - self parseMessagePattern. - self parsePragmaSequence]. self parseMethodTemporaries. + isAMethod ifTrue: [ self parsePragmaSequence ]. - isAMethod ifTrue: [self parsePragmaSequence]. self parseStatementList. + currentToken ifNotNil: [ self error ]. - currentToken ifNotNil: [self error]] - ensure:[errorBlock := nil]. ^true! Item was changed: ----- Method: SHParserST80>>parseSymbol (in category 'parse') ----- parseSymbol | c | currentToken = '#' ifTrue: [ "if token is just the #, then scan whitespace and comments and then process the next character. Squeak allows space between the # and the start of the symbol e.g. # (), # a, # 'sym' " self rangeType: #symbol. self scanWhitespace]. c := self currentChar. self failWhen: (c isNil or: [c isSeparator]). c == $( ifTrue: [ self nextChar. self scanPast: #arrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1. ^self parseArray]. c == $' ifTrue: [^self parseSymbolString]. c == $[ ifTrue: [ self nextChar. self scanPast: #byteArrayStart start: currentTokenSourcePosition end: currentTokenSourcePosition + 1. ^self parseByteArray]. ((self isSelectorCharacter: c) or: [c == $-]) ifTrue: [^self parseSymbolSelector]. + ((encodedCharSet isLetter: c) + or: [ c == $: + or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ]) - ((encodedCharSet isLetter: c) or: [ - c == $: or: [ - c == $_ and: [self allowUnderscoreSelectors] ] ]) ifTrue: [^self parseSymbolIdentifier]. ^self parseCharSymbol! Item was changed: ----- Method: SHParserST80>>parseSymbolIdentifier (in category 'parse') ----- parseSymbolIdentifier + | c start end | c := self currentChar. + self failUnless: ( + (encodedCharSet isLetter: c) + or: [ c == $: + or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ]). - self failUnless: ((encodedCharSet isLetter: c) or: [c == $: or: [c == $_ and: [self allowUnderscoreSelectors]]]). start := sourcePosition. + [ + c := self nextChar. + (encodedCharSet isAlphaNumeric: c) + or: [ c == $: + or: [ allowUnderscoreSelectors and: [ c == $_] ] ] ] whileTrue. - [c := self nextChar. - (encodedCharSet isAlphaNumeric: c) or: [c == $: or: [c == $_ and: [self allowUnderscoreSelectors]]]] whileTrue. end := sourcePosition - 1. c := source copyFrom: start - 1 to: end. self scanPast: #symbol start: start - 1 end: end. ^c! Item was changed: ----- Method: SHParserST80>>peekChar (in category 'scan') ----- peekChar + ^source at: sourcePosition + 1 ifAbsent: $ ! Item was changed: ----- Method: SHParserST80>>pushTemporary: (in category 'parse support') ----- + pushTemporary: aString + + (temporaries at: blockDepth ifAbsentPut: [ OrderedCollection new ]) - pushTemporary: aString - (temporaries at: blockDepth ifAbsentPut: [OrderedCollection new: 10]) add: aString! Item was changed: ----- Method: SHParserST80>>resolve: (in category 'identifier testing') ----- resolve: aString aString = #self ifTrue: [ ^#self ]. aString = #true ifTrue: [ ^#true ]. aString = #false ifTrue: [ ^#false ]. aString = #nil ifTrue: [ ^#nil ]. aString = #super ifTrue: [ ^#super ]. aString = #thisContext ifTrue: [ ^#thisContext ]. (self isBlockTempName: aString) ifTrue: [^#blockTempVar]. (self isBlockArgName: aString) ifTrue: [^#blockArg]. (self isMethodTempName: aString) ifTrue: [^#tempVar]. (self isMethodArgName: aString) ifTrue: [^#methodArg]. (instanceVariables includes: aString) ifTrue: [^#instVar]. workspace ifNotNil: [(workspace hasBindingOf: aString) ifTrue: [^#workspaceVar]]. + (Symbol lookup: aString) ifNotNil: [:sym | + classOrMetaClass + ifNotNil: [ + classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c | - Symbol hasInterned: aString ifTrue: [:sym | - classOrMetaClass isBehavior - ifTrue: [ - classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | (c classPool bindingOf: sym) ifNotNil: [^#classVar]. c sharedPools do: [:p | (p bindingOf: sym) ifNotNil: [^#poolConstant]]. (c environment bindingOf: sym) ifNotNil: [^#globalVar]]] + ifNil: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]]. - ifFalse: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]]. ^self resolvePartial: aString! Item was changed: ----- Method: SHParserST80>>resolvePartial: (in category 'identifier testing') ----- resolvePartial: aString "check if any identifier begins with aString" (#('self' 'super' 'true' 'false' 'nil' 'thisContext') anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier]. (self isIncompleteBlockTempName: aString) ifTrue: [^#incompleteIdentifier]. (self isIncompleteBlockArgName: aString) ifTrue: [^#incompleteIdentifier]. (self isIncompleteMethodTempName: aString) ifTrue: [^#incompleteIdentifier]. (self isIncompleteMethodArgName: aString) ifTrue: [^#incompleteIdentifier]. (instanceVariables anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier]. workspace ifNotNil: [(workspace hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. + classOrMetaClass + ifNotNil: [ - classOrMetaClass isBehavior - ifTrue: [ classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | (c classPool hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]. c sharedPools do: [:p | (p hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. (c environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]] + ifNil: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. - ifFalse: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. ^#undefinedIdentifier! Item was changed: ----- Method: SHParserST80>>resolvePartialPragmaArgument: (in category 'identifier testing') ----- resolvePartialPragmaArgument: aString "check if any valid pragma argument begins with aString" (#('true' 'false' 'nil') anySatisfy: [:each | each beginsWith: aString]) ifTrue: [^#incompleteIdentifier]. "should really check that a matching binding is for a Class?" + classOrMetaClass + ifNotNil: [ - classOrMetaClass isBehavior - ifTrue: [ classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | (c environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]] + ifNil: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. - ifFalse: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. ^#undefinedIdentifier! Item was changed: ----- Method: SHParserST80>>resolvePragmaArgument: (in category 'identifier testing') ----- resolvePragmaArgument: aString (#('true' 'false' 'nil') includes: aString) ifTrue: [^aString asSymbol]. "should really check that global is a class?" + (Symbol lookup: aString) ifNotNil: [:sym | + classOrMetaClass + ifNotNil: [ - Symbol hasInterned: aString ifTrue: [:sym | - classOrMetaClass isBehavior - ifTrue: [ classOrMetaClass theNonMetaClass withAllSuperclasses do: [:c | (c environment bindingOf: sym) ifNotNil: [^#globalVar]]] + ifNil: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]]. - ifFalse: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]]. ^self resolvePartialPragmaArgument: aString! Item was changed: ----- Method: SHParserST80>>scanComment (in category 'scan') ----- scanComment + + | start | + start := sourcePosition. + (sourcePosition := source indexOf: $" startingAt: start + 1) = 0 ifTrue: [ + sourcePosition := source size + 1. + self rangeType: #unfinishedComment start: start end: source size. + ^self error ]. + start < sourcePosition ifTrue: [ + self rangeType: #comment start: start end: sourcePosition ]. + self + nextChar; + scanWhitespace! - | c s e | - s := sourcePosition. - - [sourcePosition := sourcePosition + 1. - (c := self currentChar) - ifNil: [ - self rangeType: #unfinishedComment start: s end: source size. - ^self error ": 'unfinished comment'"]. - c == $"] - whileFalse: []. - e := sourcePosition. - s < e ifTrue: [self rangeType: #comment start: s end: e]. - self nextChar. - self scanWhitespace! Item was changed: ----- Method: SHParserST80>>scanIdentifier (in category 'scan') ----- scanIdentifier + | c start | start := sourcePosition. + [ + (encodedCharSet isAlphaNumeric: (c := self nextChar)) + or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ] whileTrue. + (c == $: and: [ (self isSelectorCharacter: self peekChar) not ]) + ifTrue: [ self nextChar ]. - [(encodedCharSet isAlphaNumeric: (c := self nextChar)) or: [c == $_ and: [self allowUnderscoreSelectors]]] whileTrue. - (c == $: and: [(self isSelectorCharacter: self peekChar) not]) - ifTrue: [self nextChar]. currentToken := source copyFrom: start to: sourcePosition - 1. currentTokenSourcePosition := start! Item was changed: ----- Method: SHParserST80>>scanNext (in category 'scan') ----- scanNext + self scanWhitespace. + currentTokenFirst := self currentChar ifNil: [ + " end of input " + currentTokenFirst := $ . + currentTokenSourcePosition := nil. + currentToken := nil. + ^nil ]. + (encodedCharSet isDigit: currentTokenFirst) ifTrue: [ ^self scanNumber ]. - currentTokenFirst := self currentChar. - currentTokenFirst - ifNil: [" end of input " - currentTokenFirst := $ . - currentTokenSourcePosition := nil. - currentToken := nil. - ^nil]. - (encodedCharSet isDigit: currentTokenFirst) ifTrue: [^self scanNumber]. ((encodedCharSet isLetter: currentTokenFirst) or: [ + allowUnderscoreSelectors and: [ currentTokenFirst == $_ ] ]) + ifTrue: [ ^self scanIdentifier ]. - currentTokenFirst == $_ and: [ self allowUnderscoreSelectors ] ]) - ifTrue: [^self scanIdentifier]. ^self scanBinary!

1 0

Jump to page: