[squeak-dev] The Inbox: ShoutCore-eem.96.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:12:01 UTC 2022
A new version of ShoutCore was added to project The Inbox: http://source.squeak.org/inbox/ShoutCore-eem.96.mcz ==================== Summary ==================== Name: ShoutCore-eem.96 Author: eem Time: 12 July 2022, 2:56:07.854662 pm UUID: 3cc67eea-1f93-4fec-8eb6-a77683a6bf1f Ancestors: ShoutCore-mt.95 Fix parsing of unary selectors beginning and/or ending weith underscores, which are legal when Scanner prefAllowUnderscoreSelectors. =============== Diff against ShoutCore-mt.95 =============== Item was removed: - SystemOrganization addCategory: #'ShoutCore-Monticello'! - SystemOrganization addCategory: #'ShoutCore-Parsing'! - SystemOrganization addCategory: #'ShoutCore-Styling'! Item was removed: - ----- Method: Behavior>>hasBindingThatBeginsWith: (in category '*ShoutCore-Parsing') ----- - hasBindingThatBeginsWith: aString - "Answer true if the receiver has a binding that begins with aString, false otherwise" - - "First look in classVar dictionary." - (self classPool hasBindingThatBeginsWith: aString) ifTrue:[^true]. - "Next look in shared pools." - self sharedPools do:[:pool | - (pool hasBindingThatBeginsWith: aString) ifTrue: [^true]]. - ^false! Item was removed: - ----- Method: Behavior>>shoutParserClass (in category '*ShoutCore-Parsing') ----- - shoutParserClass - "Answer the parser class" - ^SHParserST80! Item was removed: - ----- Method: Class>>metaShoutParserClass (in category '*ShoutCore-Parsing') ----- - metaShoutParserClass - "BE CAREFUL!! If you provide your own class to treat class-side (resp. meta) methods, you MUST account for the #meta*Class selector to use the default implementation in that case. That is, the methods behind #meta*Class MUST always get the default Smalltalk treatment." - - ^ super shoutParserClass! Item was removed: - ----- Method: Dictionary>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - "Answer true if the receiver has a key that begins with aString, false otherwise" - - self keysDo:[:each | - (each beginsWith: aString) - ifTrue:[^true]]. - ^false! Item was removed: - ----- Method: Environment>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - bindings associationsDo: - [:ea | (ea key beginsWith: aString) ifTrue: [^ true]]. - ^ false - - ! Item was removed: - ----- Method: MCSnapshotBrowser>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - - ^false! Item was removed: - ----- Method: Metaclass>>shoutParserClass (in category '*ShoutCore-Parsing') ----- - shoutParserClass - - ^ self theNonMetaClass metaShoutParserClass! Item was removed: - ----- Method: Model>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - - ^ false! Item was removed: - ----- Method: PseudoClass>>shoutParserClass (in category '*ShoutCore') ----- - shoutParserClass - - ^SHParserST80 - ! Item was removed: - Object subclass: #SHMCClassDefinition - instanceVariableNames: 'classDefinition items meta' - classVariableNames: '' - poolDictionaries: '' - category: 'ShoutCore-Monticello'! Item was removed: - ----- Method: SHMCClassDefinition class>>classDefinition:items:meta: (in category 'as yet unclassified') ----- - classDefinition: aMCClassDefinition items: anObject meta: aBoolean - ^self new - classDefinition: aMCClassDefinition; - items: anObject; - meta: aBoolean; - yourself! Item was removed: - ----- Method: SHMCClassDefinition>>allInstVarNames (in category 'act like a class') ----- - allInstVarNames - | superclassOrDef answer classOrDef instVars| - - answer := meta - ifTrue:[classDefinition classInstVarNames asArray] - ifFalse:[ classDefinition instVarNames asArray]. - classOrDef := classDefinition. - [superclassOrDef := (classOrDef isKindOf: MCClassDefinition) - ifTrue:[ |s| - s := classOrDef superclassName. - items - detect: [:ea | ea isClassDefinition and: [ea className = s]] - ifNone: [Smalltalk at: s asSymbol ifAbsent:[nil]]] - ifFalse:[ | sc | - sc := classOrDef superclass. - sc ifNotNil:[ - items - detect: [:ea | ea isClassDefinition and: [ea className = sc name asString]] - ifNone: [sc] ]]. - superclassOrDef isNil - ] whileFalse:[ - instVars := (superclassOrDef isKindOf: MCClassDefinition) - ifTrue:[ - meta - ifTrue:[superclassOrDef classInstVarNames] - ifFalse:[superclassOrDef instVarNames]] - ifFalse:["real" - meta - ifTrue:[superclassOrDef theNonMetaClass class instVarNames] - ifFalse:[superclassOrDef theNonMetaClass instVarNames]]. - answer := answer, instVars. - classOrDef := superclassOrDef]. - ^answer! Item was removed: - ----- Method: SHMCClassDefinition>>allowUnderscoreAssignments (in category 'act like a class') ----- - allowUnderscoreAssignments - - ^nil! Item was removed: - ----- Method: SHMCClassDefinition>>bindingOf: (in category 'act like environment') ----- - bindingOf: aSymbol - | binding | - (binding := Smalltalk bindingOf: aSymbol) - ifNotNil: [^binding]. - items do:[:each | - (each isClassDefinition and: [each className = aSymbol]) - ifTrue:[^aSymbol -> each]]. - ^nil! Item was removed: - ----- Method: SHMCClassDefinition>>classDefinition: (in category 'accessing') ----- - classDefinition: aMCClassDefinition - classDefinition := aMCClassDefinition! Item was removed: - ----- Method: SHMCClassDefinition>>classPool (in category 'act like a class') ----- - classPool - | d | - d := Dictionary new. - classDefinition classVarNames do:[:each | - d at: each put: nil]. - ^d! Item was removed: - ----- Method: SHMCClassDefinition>>environment (in category 'act like a class') ----- - environment - ^self! Item was removed: - ----- Method: SHMCClassDefinition>>hasBindingThatBeginsWith: (in category 'act like environment') ----- - hasBindingThatBeginsWith: aString - - (Smalltalk globals hasBindingThatBeginsWith: aString) ifTrue: [^true]. - items do:[:each | - (each isClassDefinition and: [each className beginsWith: aString]) - ifTrue:[^true]]. - ^false! Item was removed: - ----- Method: SHMCClassDefinition>>items: (in category 'accessing') ----- - items: anObject - items := anObject! Item was removed: - ----- Method: SHMCClassDefinition>>meta: (in category 'accessing') ----- - meta: aBoolean - meta := aBoolean! Item was removed: - ----- Method: SHMCClassDefinition>>sharedPools (in category 'act like a class') ----- - sharedPools - | d | - d := Set new. - classDefinition poolDictionaries do: - [:poolName| - (Smalltalk at: poolName asSymbol ifAbsent:[nil]) ifNotNil: [:pool| d add: pool]]. - ^d! Item was removed: - ----- Method: SHMCClassDefinition>>shoutParserClass (in category 'act like a class') ----- - shoutParserClass - "Answer the parser class" - ^SHParserST80! Item was removed: - ----- Method: SHMCClassDefinition>>theNonMetaClass (in category 'act like a class') ----- - theNonMetaClass - ^self copy meta: false; yourself! Item was removed: - ----- Method: SHMCClassDefinition>>withAllSuperclasses (in category 'act like a class') ----- - withAllSuperclasses - - | result | - result := OrderedCollection new. - self withAllSuperclassesDo: [ :each | result addFirst: each ]. - ^result! Item was removed: - ----- Method: SHMCClassDefinition>>withAllSuperclassesDo: (in category 'act like a class') ----- - withAllSuperclassesDo: aBlock - - | superclassOrDef classOrDef | - aBlock value: self. - classOrDef := classDefinition. - [ - superclassOrDef := (classOrDef isKindOf: MCClassDefinition) - ifTrue: [ - | superclassName | - superclassName := classOrDef superclassName. - items - detect: [ :each | - each isClassDefinition and: [ - each className = superclassName ] ] - ifNone: [ Smalltalk classNamed: superclassName ] ] - ifFalse: [ - classOrDef superclass ifNotNil: [ :superclass | - | superclassName | - superclassName := superclass name asString. - items - detect: [ :each | - each isClassDefinition and: [ - each className = superclassName ] ] - ifNone: [ superclass ] ] ]. - superclassOrDef isNil ] - whileFalse: [ - aBlock value: (superclassOrDef isBehavior - ifTrue: [superclassOrDef] - ifFalse: [(superclassOrDef isKindOf: SHMCClassDefinition) - ifTrue: [superclassOrDef] - ifFalse: [SHMCClassDefinition - classDefinition: superclassOrDef - items: items - meta: (superclassOrDef className includes: $ )]]). - classOrDef := superclassOrDef ]! Item was removed: - Object subclass: #SHParserST80 - instanceVariableNames: 'classOrMetaClass source workspace arguments sourcePosition currentToken currentTokenFirst temporaries instanceVariables errorBlock currentTokenSourcePosition bracketDepth ranges environment allowUnderscoreAssignments allowUnderscoreSelectors allowBlockArgumentAssignment parseAMethod currentTokenType context' - classVariableNames: '' - poolDictionaries: '' - category: 'ShoutCore-Parsing'! - - !SHParserST80 commentStamp: 'ul 7/30/2019 00:31' 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. - - Instance Variables - allowBlockArgumentAssignment: <Boolean> - allowUnderscoreAssignments: <Boolean> - allowUnderscoreSelectors: <Boolean> - arguments: <OrderedCollection<OrderedCollection<String>|nil> - bracketDepth: <Integer> - classOrMetaClass: <Class|nil> - currentToken: <String|nil> - currentTokenFirst: <Character> - currentTokenSourcePosition: <Integer|nil> - currentTokenType: <Symbol|nil> - environment: <Environment> - errorBlock: <Block> - instanceVariables: <Array> - parseAMethod: <Boolean> - ranges: <OrderedCollection<SHRange>> - source: <String> - sourcePosition: <Integer> - temporaries: <OrderedCollection<OrderedCollection<String>|nil> - workspace: <Workspace|nil> - context: <Context|nil> - - allowBlockArgumentAssignment - The value cached at the beginning of parsing of Scanner allowBlockArgumentAssignment. - - allowUnderscoreAssignments - The value cached at the beginning of parsing of Scanner allowUnderscoreAsAssignment. - - allowUnderscoreSelectors - The value cached at the beginning of parsing of Scanner prefAllowUnderscoreSelectors. - - arguments - This OrderedCollection has an element for each scope encapsulating the current scope. - The current scope's arguments are stored in the last element. The first element holds the outermost scope's arguments. - Each element is nil when the corresponding scope doesn't have any arguments, and the element is an OrderedCollection with the names of the arguments declared at the given scope when there's at least one. - The size of this variable is the same as the size of temporaries. - - bracketDepth - Stores the number of unclosed brackets "(" and parentheses "[" before the current sourcePosition. - - classOrMetaClass - The Class or MetaClass instance, class and pool variables should be looked up during parsing or nil when not parsing code in the context of a class (e.g. when parsing code written in a Workspace). Having this set doesn't mean a method is being parsed. - - currentToken - The token being analyzed for which the next range should be created for. - - currentTokenFirst - The first character of currentToken cached for quick access or a space character when there are no more tokens to parse. - Being always a Character helps avoiding extra checks. - - currentTokenSourcePosition - The position of source the current token starts at or nil when there are no more tokens to process. - - currentTokenType - The type of the current token calculated lazily by #currentTokenType. When it has been calculated, Its value is one of #keyword, #assignment, #ansiAssignment, #binary, #name, #other and occasionally #invalid. - - environment - The Environment globals and classes should be looked up at during parsing when classOrMetaClass is nil. Its value is Smalltalk globals by default. - - errorBlock - A block used to quickly stop parsing in case of an unrecoverable parse error. - - instanceVariables - An Array with the instance variable names of classOrMetaClass or an empty Array when classOrMetaClass is nil. - - parseAMethod - A way to tell the parser to parse source as a code snippet instead of a method. Mainly used by inspectors. - - ranges - The SHRanges parsed by the parser. - - source - The source code as a String to be parsed. - - sourcePosition - souce is treated as a stream by the parser. This variable stores the stream position. - - temporaries - This OrderedCollection has an element for each scope encapsulating the current scope. - The current scope's temporaries are stored in the last element. The first element holds the outermost scope's temporaries. - Each element is nil when the corresponding scope doesn't have any temporary variables, and the element is an OrderedCollection with the names of the temporaries declared at the given scope when there's at least one. - The size of this variable is the same as the size of arguments. - - workspace - The Workspace in whose context variables should be looked up during parsing or nil when not parsing code in a workspace. - - context - The Context in which variables should be looked up during parsing or nil when not parsing within a context. - - Example (explore it): - - ranges := SHParserST80 new - classOrMetaClass: Object; - source: 'testMethod ^self'; - parse; - ranges - - Benchmark (print it): - - SHParserST80 benchmark! Item was removed: - ----- Method: SHParserST80 class>>benchmark (in category 'benchmarking') ----- - benchmark - - | methods methodCount totalTime averageTime min median percentile80 percentile95 percentile99 max | - Smalltalk garbageCollect. - methods := OrderedCollection new: 100000. - CurrentReadOnlySourceFiles cacheDuring: [ - | parser | - parser := SHParserST80 new. - SystemNavigation default allSelectorsAndMethodsDo: [ :class :selector :method | - | source start ranges | - source := method getSource asString. - start := Time utcMicrosecondClock. - ranges := parser - rangesIn: source - classOrMetaClass: class - workspace: nil - environment: nil. - methods addLast: { Time utcMicrosecondClock - start. method. ranges size } ] ]. - methods sort: #first asSortFunction. - methodCount := methods size. - totalTime := methods detectSum: #first. - averageTime := (totalTime / methodCount) rounded. - - min := methods first. - median := methods at: methodCount // 2. - percentile80 := methods at: (methodCount * 0.8) floor. - percentile95 := methods at: (methodCount * 0.95) floor. - percentile99 := methods at: (methodCount * 0.99) floor. - max := methods last. - ^' - Methods {1} - Total {2}ms - Average {3}ms - Min {4}ms {5} range(s) ({6}) - Median {7}ms {8} ranges ({9}) - 80th percentile {10}ms {11} ranges ({12}) - 95th percentile {13}ms {14} ranges ({15}) - 99th percentile {16}ms {17} ranges ({18}) - Max {19}ms {20} ranges ({21})' format: ({ - methodCount asString. - totalTime. - averageTime. - min first. - min third asString. - min second reference. - median first. - median third asString. - median second reference. - percentile80 first. - percentile80 third asString. - percentile80 second reference. - percentile95 first. - percentile95 third asString. - percentile95 second reference. - percentile99 first. - percentile99 third asString. - percentile99 second reference. - max first. - max third asString. - max second reference } replace: [ :each | - each isNumber - ifTrue: [ (each / 1000) printShowingDecimalPlaces: 3 ] - ifFalse: [ each ] ])! Item was removed: - ----- Method: SHParserST80 class>>new (in category 'instance creation') ----- - new - ^super new - initialize; - yourself! Item was removed: - ----- Method: SHParserST80>>activeArguments (in category 'accessing') ----- - activeArguments - "Parsed arguments that are in the active scope" - ^ arguments! Item was removed: - ----- Method: SHParserST80>>activeTemporaries (in category 'accessing') ----- - activeTemporaries - "Parsed temporaries that are in the active scope" - ^ temporaries! Item was removed: - ----- Method: SHParserST80>>addRangeType: (in category 'recording ranges') ----- - addRangeType: aSymbol - - ^self - addRangeType: aSymbol - start: currentTokenSourcePosition - end: currentTokenSourcePosition + currentToken size - 1! Item was removed: - ----- Method: SHParserST80>>addRangeType:start:end: (in category 'recording ranges') ----- - addRangeType: aSymbol start: s end: e - - ^ranges addLast: (SHRange start: s end: e type: aSymbol)! Item was removed: - ----- Method: SHParserST80>>classOrMetaClass: (in category 'accessing') ----- - classOrMetaClass: aClass - classOrMetaClass := aClass! Item was removed: - ----- Method: SHParserST80>>currentChar (in category 'scan') ----- - currentChar - ^source at: sourcePosition ifAbsent: nil! Item was removed: - ----- Method: SHParserST80>>currentTokenType (in category 'parse support') ----- - currentTokenType - "Cache and return the type of currentToken of #(name keyword binary assignment ansiAssignment other)" - - ^currentTokenType ifNil: [ - currentTokenType := currentToken ifNotNil: [ - currentTokenFirst isLetter - ifFalse: [ - currentTokenFirst == $_ - ifTrue: [ - (allowUnderscoreSelectors - and: [ currentToken size > 1 - and: [ currentToken last == $: ] ]) - ifTrue: [ #keyword ] - ifFalse: [ - (allowUnderscoreAssignments and: [ currentToken = '_' ]) ifTrue: [ - #assignment ] ] ] - ifFalse: [ - currentToken = ':=' - ifTrue: [ #ansiAssignment ] - ifFalse: [ - (currentToken allSatisfy: [ :each | self isSelectorCharacter: each ]) ifTrue: [ #binary ] ] ] ] - ifTrue: [ - currentToken last == $: - ifTrue: [ #keyword ] - ifFalse: [ - (currentToken last isAlphaNumeric or: [ - allowUnderscoreSelectors and: [ - currentToken last == $_ ] ]) - ifTrue: [ #name ] ] ] ]. - currentTokenType ifNil: [ currentTokenType := #other ] ]! Item was removed: - ----- Method: SHParserST80>>environment: (in category 'accessing') ----- - environment: anObject - environment := anObject! Item was removed: - ----- Method: SHParserST80>>fail (in category 'error handling') ----- - fail - - | start | - start := (ranges isEmpty ifTrue: [ 1 ] ifFalse: [ ranges last end + 1 ]). - start <= source size ifTrue: [ - self - addRangeType: #excessCode - start: start - end: source size ]. - errorBlock value! Item was removed: - ----- Method: SHParserST80>>failUnless: (in category 'error handling') ----- - failUnless: aBoolean - aBoolean ifFalse:[self fail] - ! Item was removed: - ----- Method: SHParserST80>>failWhen: (in category 'error handling') ----- - failWhen: aBoolean - aBoolean ifTrue:[self fail]! Item was removed: - ----- Method: SHParserST80>>initialize (in category 'accessing') ----- - initialize - environment := Smalltalk globals.! Item was removed: - ----- Method: SHParserST80>>initializeInstanceVariables (in category 'parse support') ----- - initializeInstanceVariables - - instanceVariables := classOrMetaClass - ifNil: [ #() ] - ifNotNil: [ classOrMetaClass allInstVarNames asArray ]. - allowUnderscoreAssignments := Scanner allowUnderscoreAsAssignment. - allowUnderscoreSelectors := Scanner prefAllowUnderscoreSelectors. - allowBlockArgumentAssignment := Scanner allowBlockArgumentAssignment. - sourcePosition := 1. - arguments - ifNil: [ arguments := OrderedCollection with: nil ] - ifNotNil: [ arguments reset; addLast: nil ]. - temporaries - ifNil: [ temporaries := OrderedCollection with: nil ] - ifNotNil: [ temporaries reset; addLast: nil ]. - context ifNotNil: [ self initializeVariablesFromContext ]. - bracketDepth := 0. - ranges - ifNil: [ ranges := OrderedCollection new: 40 "Covers over 80% of all methods." ] - ifNotNil: [ ranges reset ]! Item was removed: - ----- Method: SHParserST80>>initializeVariablesFromContext (in category 'parse support') ----- - initializeVariablesFromContext - - | contextSourcePcIndex contextSource contextSourceParser | - contextSourcePcIndex := (context debuggerMap - rangeForPC: (context isDead ifTrue: [context endPC] ifFalse: [context pc]) - in: context method - contextIsActiveContext: true "... to really use the context's pc.") - start. - contextSource := context method getSource. - contextSourceParser := self class new - classOrMetaClass: context method methodClass; - environment: self environment; - source: (contextSource first: (contextSourcePcIndex min: contextSource size)); - yourself. - contextSourceParser parse. - arguments := contextSourceParser activeArguments. - temporaries := contextSourceParser activeTemporaries! Item was removed: - ----- Method: SHParserST80>>isDigit:base: (in category 'character testing') ----- - isDigit: aCharacter base: anInteger - "Answer true if aCharacter is a digit or a capital letter appropriate for base anInteger" - - | digitValue | - ^(digitValue := aCharacter digitValue) >= 0 and: [ - digitValue < anInteger ]! Item was removed: - ----- Method: SHParserST80>>isSelectorCharacter: (in category 'character testing') ----- - isSelectorCharacter: aCharacter - - | asciiValue | - ('"#$'':().;[]{}^_' includes: aCharacter) ifTrue: [ ^false ]. - aCharacter isSeparator ifTrue:[ ^false ]. - aCharacter isAlphaNumeric 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 removed: - ----- Method: SHParserST80>>nextChar (in category 'scan') ----- - nextChar - - ^source at: (sourcePosition := sourcePosition + 1) ifAbsent: $ ! Item was removed: - ----- Method: SHParserST80>>parse (in category 'parse') ----- - parse - "Parse the receiver's text as a Smalltalk method" - - self parse: (parseAMethod ifNil: [ classOrMetaClass notNil ]). - errorBlock := nil! Item was removed: - ----- 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. - errorBlock := [^false]. "This must be defined in this method, as the goal is to return from this method in case of an error." - self scanNext. - isAMethod ifTrue: [ - self - parseMessagePattern; - parsePragmaSequence ]. - self parseTemporaries. - isAMethod ifTrue: [ self parsePragmaSequence ]. - self parseStatementList. - currentToken ifNotNil: [ self fail ]. - ^true! Item was removed: - ----- Method: SHParserST80>>parseAMethod: (in category 'accessing') ----- - parseAMethod: aBoolean - - parseAMethod := aBoolean! Item was removed: - ----- Method: SHParserST80>>parseArgument: (in category 'parse') ----- - parseArgument: expectedArgumentType - "Add currentToken to the current scope as argument. Scan past expectedArgumentType if the argument is valid." - - self currentTokenType == #name ifFalse: [ self fail ": name expected" ]. - (self reservedKeywordNames includes: currentToken) ifTrue: [ - "Reserved keyword" - ^self scanPast: #invalid ]. - - 1 to: arguments size do: [ :index | - (arguments at: index) ifNotNil: [ :scopeArguments | - (scopeArguments includes: currentToken) ifTrue: [ - "Name is already used." - ^self scanPast: #invalid ] ]. - (temporaries at: index) ifNotNil: [ :scopeTemporaries | - (scopeTemporaries includes: currentToken) ifTrue: [ - "Name is already used." - ^self scanPast: #invalid ] ] ]. - - arguments last - ifNil: [ arguments atLast: 1 put: (OrderedCollection with: currentToken) ] - ifNotNil: [ :scopeArguments | scopeArguments addLast: currentToken ]. - ^self scanPast: expectedArgumentType! Item was removed: - ----- Method: SHParserST80>>parseArray (in category 'parse') ----- - parseArray - [currentTokenFirst == $)] whileFalse: [self parseLiteralArrayElement]. - self scanPast: #arrayEnd! Item was removed: - ----- Method: SHParserST80>>parseBinary (in category 'parse') ----- - parseBinary - - self parseUnary. - [ self currentTokenType == #binary ] - whileTrue: [ - self scanPast: ( - (Symbol lookup: currentToken) - ifNotNil: [ #binary ] - ifNil: [ - (Symbol thatStartsCaseSensitive: currentToken skipping: nil) - ifNil: [ #undefinedBinary ] - ifNotNil:[ #incompleteBinary ] ]). - self - parseTerm; - parseUnary ]! Item was removed: - ----- Method: SHParserST80>>parseBinaryMessagePattern (in category 'parse') ----- - parseBinaryMessagePattern - - self - scanPast: #patternBinary; - parseArgument: #patternArg! Item was removed: - ----- Method: SHParserST80>>parseBlock (in category 'parse') ----- - parseBlock - - arguments addLast: nil. - temporaries addLast: nil. - bracketDepth := bracketDepth + 1. - self - scanPastBracket: #blockStart; - parseBlockArguments; - parseTemporaries; - parseStatementList; - failUnless: currentTokenFirst == $]; - scanPastBracket: #blockEnd. - bracketDepth := bracketDepth - 1. - arguments removeLast. - temporaries removeLast! Item was removed: - ----- Method: SHParserST80>>parseBlockArguments (in category 'parse') ----- - parseBlockArguments - - currentTokenFirst == $: ifFalse: [ ^self ]. - [ currentTokenFirst == $: ] whileTrue: [ - self - scanPast: #blockArgColon; - parseArgument: #blockPatternArg ]. - (self parseVerticalBarForTemporaries: #blockArgsBar) ifFalse: [ - self fail ": Missing block args bar" ]! Item was removed: - ----- Method: SHParserST80>>parseBraceArray (in category 'parse') ----- - parseBraceArray - self parseStatementListForBraceArray. - self failUnless: currentTokenFirst == $}. - self scanPast: #rightBrace! Item was removed: - ----- Method: SHParserST80>>parseByteArray (in category 'parse') ----- - parseByteArray - - [currentTokenFirst == $]] whileFalse: [ - currentTokenFirst isDigit - ifTrue: [ - "do not parse the number, can be time consuming" - self scanPast: #number] - ifFalse: [ self fail ] ]. - self scanPast: #byteArrayEnd! Item was removed: - ----- Method: SHParserST80>>parseCascade (in category 'parse') ----- - parseCascade - self parseKeyword. - [currentTokenFirst == $;] - whileTrue: [ - self scanPast: #cascadeSeparator. - self parseKeyword]! Item was removed: - ----- Method: SHParserST80>>parseCharSymbol (in category 'parse') ----- - parseCharSymbol - | s e | - s := sourcePosition - 1. - e := sourcePosition. - self nextChar. - self scanPast: #symbol start: s end: e! Item was removed: - ----- Method: SHParserST80>>parseExpression (in category 'parse') ----- - parseExpression - - | identifierType | - self currentTokenType == #name ifFalse: [ - ^self - parseTerm; - parseCascade ]. - self scanPast: (identifierType := self parseIdentifier). - (self currentTokenType == #ansiAssignment or: [ currentTokenType == #assignment ]) - ifFalse: [ ^self parseCascade ]. - (identifierType == #methodArg - or: [ (identifierType == #blockArg - and: [ allowBlockArgumentAssignment not ]) - or: [ self reservedKeywordNames includes: identifierType ] ]) - ifTrue: [ - "Cannot store into those variables." - currentTokenType := #invalid ]. - self - scanPast: currentTokenType; - parseExpression! Item was removed: - ----- Method: SHParserST80>>parseIdentifier (in category 'identifier testing') ----- - parseIdentifier - "currentToken is either a name of an existing variable, a prefix of a variable or an undefined identifier. Return the appropriate range type for it." - - currentToken = #self ifTrue: [ ^#self ]. - currentToken = #true ifTrue: [ ^#true ]. - currentToken = #false ifTrue: [ ^#false ]. - currentToken = #nil ifTrue: [ ^#nil ]. - currentToken = #super ifTrue: [ ^#super ]. - currentToken = #thisContext ifTrue: [ ^#thisContext ]. - - arguments size to: 1 by: -1 do: [ :level | - (arguments at: level) ifNotNil: [ :levelArguments | - (levelArguments includes: currentToken) ifTrue: [ - ^level = 1 - ifTrue: [ #methodArg ] - ifFalse: [ #blockArg ] ] ]. - (temporaries at: level) ifNotNil: [ :levelTemporaries | - (levelTemporaries includes: currentToken) ifTrue: [ - ^level = 1 - ifTrue: [ #tempVar ] - ifFalse: [ #blockTempVar ] ] ] ]. - - (instanceVariables includes: currentToken) ifTrue: [^#instVar]. - - workspace - ifNotNil: [(workspace hasBindingOf: currentToken) ifTrue: [^#workspaceVar]]. - - (Symbol lookup: currentToken) ifNotNil: [:sym | - classOrMetaClass - ifNotNil: [ - classOrMetaClass theNonMetaClass withAllSuperclassesDo: [: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]]]. - ^self parsePartialIdentifier! Item was removed: - ----- Method: SHParserST80>>parseKeyword (in category 'parse') ----- - parseKeyword - - | keyword rangeIndices | - self parseBinary. - self currentTokenType == #keyword ifFalse: [ ^self ]. - [ - keyword := currentToken. - self addRangeType: #keyword. - rangeIndices := { ranges size }. - self - scanNext; - parseTerm; - parseBinary. - [self currentTokenType == #keyword] - whileTrue: [ - keyword := keyword, currentToken. - self addRangeType: #keyword. - "remember where this keyword token is in ranges" - rangeIndices := rangeIndices copyWith: ranges size. - self - scanNext; - parseTerm; - parseBinary ] - ] ensure: [ | type | - "do this in an ensure so that it happens even if the errorBlock evaluates before getting here" - "patch up the keyword tokens, so that incomplete and undefined ones look different" - (keyword isEmpty or:[(Symbol lookup: keyword) notNil]) - ifFalse:[ - type := (Symbol thatStartsCaseSensitive: keyword skipping: nil) - ifNil: [#undefinedKeyword] - ifNotNil:[#incompleteKeyword]. - rangeIndices do: [:i | (ranges at: i) type: type]]]! Item was removed: - ----- Method: SHParserST80>>parseKeywordMessagePattern (in category 'parse') ----- - parseKeywordMessagePattern - - [ self currentTokenType == #keyword ] whileTrue: [ - self - scanPast: #patternKeyword; - parseArgument: #patternArg ]! Item was removed: - ----- Method: SHParserST80>>parseLiteral: (in category 'parse') ----- - parseLiteral: inArray - - currentTokenFirst == $$ - ifTrue: [ - | pos | - self failWhen: self currentChar isNil. - self addRangeType: #'$'. - pos := currentTokenSourcePosition + 1. - self nextChar. - ^self scanPast: #character start: pos end: pos]. - currentTokenFirst isDigit - 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 ]]) - ifTrue: [ - "single - can be a symbol in an Array" - ^self scanPast: #symbol]. - self scanPast: #-. - self failWhen: currentToken isNil. - "token isNil ifTrue: [self fail: '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 fail ": 'argument missing'"! Item was removed: - ----- 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 ]. - ^self parseLiteral: true! Item was removed: - ----- Method: SHParserST80>>parseMessagePattern (in category 'parse') ----- - parseMessagePattern - - self currentTokenType - caseOf: { - [ #name ] -> [ self parseUnaryMessagePattern ]. - [ #binary ] -> [ self parseBinaryMessagePattern ]. - [ #keyword ] -> [ self parseKeywordMessagePattern ] } - otherwise: [ self fail ]! Item was removed: - ----- Method: SHParserST80>>parsePartialIdentifier (in category 'identifier testing') ----- - parsePartialIdentifier - "Decide whether currentToken is an #incompleteIdentifier or an #undefinedIdentifier. - This method has many different return statements, but only returns two range parts so far. - It might be changed to return different range types for different variable type prefixes." - - (self reservedKeywordNames anySatisfy: [:each | each beginsWith: currentToken]) - ifTrue: [^#incompleteIdentifier]. - - arguments size to: 1 by: -1 do: [ :level | - (arguments at: level) ifNotNil: [ :levelArguments | - (levelArguments anySatisfy: [ :each | each beginsWith: currentToken ]) ifTrue: [ - ^level = 1 - ifTrue: [ #incompleteIdentifier ] - ifFalse: [ #incompleteIdentifier ] ] ]. - (temporaries at: level) ifNotNil: [ :levelTemporaries | - (levelTemporaries anySatisfy: [ :each | each beginsWith: currentToken ]) ifTrue: [ - ^level = 1 - ifTrue: [ #incompleteIdentifier ] - ifFalse: [ #incompleteIdentifier ] ] ] ]. - - (instanceVariables anySatisfy: [:each | each beginsWith: currentToken]) ifTrue: [^#incompleteIdentifier]. - - workspace - ifNotNil: [(workspace hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]]. - - classOrMetaClass - ifNotNil: [ - classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c | - (c classPool hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]. - c sharedPools do: [:p | (p hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]]. - (c environment hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]]] - ifNil: [(environment hasBindingThatBeginsWith: currentToken) ifTrue: [^#incompleteIdentifier]]. - ^#undefinedIdentifier! Item was removed: - ----- Method: SHParserST80>>parsePragmaBinary (in category 'parse pragma') ----- - parsePragmaBinary - - self scanPast: #pragmaBinary. - self currentTokenType == #name - ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)] - ifFalse:[ self parseLiteral: false]. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd! Item was removed: - ----- Method: SHParserST80>>parsePragmaDefault (in category 'parse pragma') ----- - parsePragmaDefault - "Parse unary, binary, and keyword pragmas." - - self currentTokenType - caseOf: { - [ #name ] -> [ - self scanPast: #pragmaUnary. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd ]. - [ #binary ] -> [ self parsePragmaBinary ]. - [ #keyword ] -> [ self parsePragmaKeyword ] } - otherwise: [ self fail ": 'Invalid External Function Calling convention'" ]. ! Item was removed: - ----- Method: SHParserST80>>parsePragmaKeyword (in category 'parse pragma') ----- - parsePragmaKeyword - - [self currentTokenType == #keyword] - whileTrue:[ - self scanPast: #pragmaKeyword. - self currentTokenType == #name - ifTrue:[self scanPast: (self resolvePragmaArgument: currentToken)] - ifFalse:[ self parseLiteral: false]]. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd! Item was removed: - ----- Method: SHParserST80>>parsePragmaSequence (in category 'parse pragma') ----- - parsePragmaSequence - - [currentToken = '<' ] - whileTrue: [ - self scanPast: #primitiveOrExternalCallStart. - currentToken - ifNotNil: [self parsePragmaStatement] - ifNil: [self fail]].! Item was removed: - ----- Method: SHParserST80>>parsePragmaStatement (in category 'parse pragma') ----- - parsePragmaStatement - "Parse a pragma statement. The leading '<' has already been consumed. The currentToken is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. - - Note that custom pragma parsers need to fulfill two requirements: - - method selector must match the current token as simple getter, - e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive - - method must have pragma <pragmaParser> to be called." - - "1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas." - currentToken last == $: ifTrue: [ - "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>." - (Symbol lookup: currentToken allButLast) ifNotNil: [:parserSelector | - SHParserST80 methodDict at: parserSelector ifPresent: [:parserMethod | - "3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." - (parserMethod hasPragma: #pragmaParser) - ifTrue: [^ self executeMethod: parserMethod]]]]. - - "X) No custom pragma parser found. Use the default one." - ^ self parsePragmaDefault! Item was removed: - ----- Method: SHParserST80>>parseStatement (in category 'parse') ----- - parseStatement - currentTokenFirst == $^ ifTrue: [self scanPast: #return]. - self parseExpression! Item was removed: - ----- Method: SHParserST80>>parseStatementList (in category 'parse') ----- - parseStatementList - - [[currentTokenFirst == $.] whileTrue: [self scanPast: #statementSeparator]. - (currentToken notNil and: [currentTokenFirst ~~ $]]) - ifTrue: [self parseStatement]. - currentTokenFirst == $.] - whileTrue: [self scanPast: #statementSeparator]! Item was removed: - ----- Method: SHParserST80>>parseStatementListForBraceArray (in category 'parse') ----- - parseStatementListForBraceArray - "same as parseStatementList, but does not allow empty statements e.g {...$a...}. - A single terminating . IS allowed e.g. {$a.} " - - - [currentTokenFirst ~~ $} ifTrue: [self parseStatement]. - currentTokenFirst == $.] - whileTrue: [self scanPast: #statementSeparator]! Item was removed: - ----- Method: SHParserST80>>parseString (in category 'parse') ----- - parseString - - | stringStart | - stringStart := sourcePosition - 1. - [ - (sourcePosition := source indexOf: $' startingAt: sourcePosition) = 0 ifTrue: [ - self - addRangeType: #unfinishedString start: stringStart end: source size; - fail ": 'unfinished string'"]. - self peekChar == $' - ifTrue: [ - sourcePosition := sourcePosition + 1. - true ] - ifFalse: [ false ] ] - whileTrue: [ sourcePosition := sourcePosition + 1 ]. - sourcePosition := sourcePosition + 1. - self scanPast: #string start: stringStart end: sourcePosition - 1! Item was removed: - ----- Method: SHParserST80>>parseStringOrSymbol (in category 'parse') ----- - parseStringOrSymbol - - currentTokenFirst == $' ifTrue: [ ^self parseString ]. - currentTokenFirst == $# ifTrue: [ ^self parseSymbol ]. - self fail! Item was removed: - ----- Method: SHParserST80>>parseSymbol (in category 'parse') ----- - parseSymbol - - | c | - currentToken size = 1 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 - addRangeType: #symbol; - scanWhitespace ]. - c := self currentChar. - self failWhen: (c isNil or: [c isSeparator]). - c == $( ifTrue: [ - ^self - nextChar; - scanPast: #arrayStart - start: currentTokenSourcePosition - end: currentTokenSourcePosition + 1; - parseArray]. - c == $' ifTrue: [^self parseSymbolString]. - c == $[ ifTrue: [ - ^self - nextChar; - scanPast: #byteArrayStart - start: currentTokenSourcePosition - end: currentTokenSourcePosition + 1; - parseByteArray ]. - (self isSelectorCharacter: c) ifTrue: [ ^self parseSymbolSelector ]. - (c isLetter - or: [ c == $: - or: [ c == $_ and: [ allowUnderscoreSelectors ] ] ]) - ifTrue: [^self parseSymbolIdentifier]. - ^self parseCharSymbol! Item was removed: - ----- Method: SHParserST80>>parseSymbolIdentifier (in category 'parse') ----- - parseSymbolIdentifier - - | c start end | - c := self currentChar. - self failUnless: ( - c isLetter - or: [ c == $: - or: [ allowUnderscoreSelectors and: [ c == $_ ] ] ]). - start := sourcePosition. - [ - (c := self nextChar) isAlphaNumeric - or: [ c == $: - 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 removed: - ----- Method: SHParserST80>>parseSymbolSelector (in category 'parse') ----- - parseSymbolSelector - | start end | - start := sourcePosition - 1. - end := sourcePosition. - [self isSelectorCharacter: self nextChar] - whileTrue: [end := sourcePosition]. - self scanPast: #symbol start: start end: end! Item was removed: - ----- Method: SHParserST80>>parseSymbolString (in category 'parse') ----- - parseSymbolString - | first c last | - first := sourcePosition. - self nextChar. - [(c := self currentChar) - ifNil: [ - self addRangeType: #unfinishedString start: first end: source size. - self fail ": 'unfinished string'"]. - c ~~ $' or: [ - self peekChar == $' - ifTrue: [sourcePosition := sourcePosition + 1.true] - ifFalse: [false]] - ] whileTrue: [sourcePosition := sourcePosition + 1]. - last := sourcePosition. - self - nextChar; - scanPast: #stringSymbol start: first - 1 end: last! Item was removed: - ----- Method: SHParserST80>>parseTemporaries (in category 'parse') ----- - parseTemporaries - - | barRangeType temporaryRangeType | - temporaries size = 1 - ifTrue: [ - barRangeType := #methodTempBar. - temporaryRangeType := #patternTempVar ] - ifFalse: [ - barRangeType := #blockTempBar. - temporaryRangeType := #blockPatternTempVar ]. - (self parseVerticalBarForTemporaries: barRangeType) ifFalse: [ ^self ]. - [ self currentTokenType == #name ] whileTrue: [ - self parseTemporary: temporaryRangeType ]. - (self parseVerticalBarForTemporaries: barRangeType) ifFalse: [ - self fail ": Missing closing temp bar" ]! Item was removed: - ----- Method: SHParserST80>>parseTemporary: (in category 'parse') ----- - parseTemporary: expectedTemporaryType - "Add currentToken to the current scope as temporary. Scan past expectedTemporaryType if the argument is valid. Assume that currentTokenType is #name." - - (self reservedKeywordNames includes: currentToken) ifTrue: [ - "Reserved keyword" - ^self scanPast: #invalid ]. - - 1 to: arguments size do: [ :index | - (arguments at: index) ifNotNil: [ :scopeArguments | - (scopeArguments includes: currentToken) ifTrue: [ - "Name is already used." - ^self scanPast: #invalid ] ]. - (temporaries at: index) ifNotNil: [ :scopeTemporaries | - (scopeTemporaries includes: currentToken) ifTrue: [ - "Name is already used." - ^self scanPast: #invalid ] ] ]. - - temporaries last - ifNil: [ temporaries atLast: 1 put: (OrderedCollection with: currentToken) ] - ifNotNil: [ :scopeTemporaries | scopeTemporaries addLast: currentToken ]. - ^self scanPast: expectedTemporaryType! Item was removed: - ----- Method: SHParserST80>>parseTerm (in category 'parse') ----- - parseTerm - - currentToken ifNil: [ self fail ": Term expected" ]. - currentTokenFirst == $( ifTrue: [ - bracketDepth := bracketDepth + 1. - self - scanPastBracket: #leftParenthesis; - parseExpression; - failUnless: currentTokenFirst == $); - scanPastBracket: #rightParenthesis. - ^bracketDepth := bracketDepth - 1 ]. - currentTokenFirst == $[ ifTrue: [ - ^self parseBlock ]. - currentTokenFirst == ${ ifTrue: [ - ^self - scanPast: #leftBrace; - parseBraceArray]. - self currentTokenType == #name ifTrue: [ - ^self scanPast: self parseIdentifier ]. - self parseLiteral: false! Item was removed: - ----- Method: SHParserST80>>parseUnary (in category 'parse') ----- - parseUnary - - [ self currentTokenType == #name ] whileTrue: [ - self scanPast: ( - (Symbol lookup: currentToken) - ifNotNil: [ #unary ] - ifNil:[ - (Symbol thatStartsCaseSensitive: currentToken skipping: nil) - ifNil: [ #undefinedUnary ] - ifNotNil:[ #incompleteUnary ] ]) ]! Item was removed: - ----- Method: SHParserST80>>parseUnaryMessagePattern (in category 'parse') ----- - parseUnaryMessagePattern - - self scanPast: #patternUnary - ! Item was removed: - ----- Method: SHParserST80>>parseVerticalBarForTemporaries: (in category 'parse') ----- - parseVerticalBarForTemporaries: barRangeType - - currentTokenFirst == $| ifFalse: [ ^false ]. - currentToken size = 1 - ifTrue: [ self scanPast: barRangeType ] - ifFalse: [ - "Apply a bit of surgery to separate the vertical bar from the rest of the token" - self - addRangeType: barRangeType - start: currentTokenSourcePosition - end: currentTokenSourcePosition. - currentToken := currentToken allButFirst. - currentTokenFirst := currentToken at: 1. - currentTokenType := nil. - currentTokenSourcePosition := currentTokenSourcePosition + 1 ]. - ^true! Item was removed: - ----- Method: SHParserST80>>parsingBlockArguments (in category 'token testing') ----- - parsingBlockArguments - ^ranges notEmpty and: [ranges last type == #blockPatternArg]! Item was removed: - ----- Method: SHParserST80>>peekChar (in category 'scan') ----- - peekChar - - ^source at: sourcePosition + 1 ifAbsent: $ ! Item was removed: - ----- Method: SHParserST80>>primitive (in category 'parse pragma') ----- - primitive - "Parse keywords and literals of primitive pragmas differently to emit different range tokens for different UI styling. This hook exists so that packages do not break primitive-pragma parsing by accident. Instead, this method needs to be replaced intentionally." - <pragmaParser> - - self addRangeType: #primitive. - - self scanNext. - currentTokenFirst isDigit - 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 currentTokenType == #name - ifTrue: [ self parseTemporary: #patternTempVar ] - ifFalse: [ self parseStringOrSymbol ] ]. - self failUnless: currentToken = '>'. - self scanPast: #primitiveOrExternalCallEnd! Item was removed: - ----- Method: SHParserST80>>ranges (in category 'accessing') ----- - ranges - - ^ranges! Item was removed: - ----- Method: SHParserST80>>rangesIn:classOrMetaClass:workspace:environment: (in category 'parse') ----- - rangesIn: sourceString classOrMetaClass: aBehaviour workspace: aWorkspace environment: anEnvironmentOrNil - ^ self rangesIn: sourceString classOrMetaClass: aBehaviour workspace: aWorkspace environment: anEnvironmentOrNil context: nil! Item was removed: - ----- Method: SHParserST80>>rangesIn:classOrMetaClass:workspace:environment:context: (in category 'parse') ----- - rangesIn: sourceString classOrMetaClass: aBehaviour workspace: aWorkspace environment: anEnvironmentOrNil context: aContextOrNil - anEnvironmentOrNil ifNotNil: [environment := anEnvironmentOrNil]. - aContextOrNil ifNotNil: [context := aContextOrNil]. - self - workspace: aWorkspace; - classOrMetaClass: aBehaviour; - source: sourceString. - self parse. - ^ranges! Item was removed: - ----- Method: SHParserST80>>reservedKeywordNames (in category 'accessing') ----- - reservedKeywordNames - - ^#(#self #true #false #nil #super #thisContext)! Item was removed: - ----- 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 theNonMetaClass withAllSuperclassesDo: [:c | - (c environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]] - ifNil: [(environment hasBindingThatBeginsWith: aString) ifTrue: [^#incompleteIdentifier]]. - ^#undefinedIdentifier! Item was removed: - ----- 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: [ - classOrMetaClass theNonMetaClass withAllSuperclassesDo: [:c | - (c environment bindingOf: sym) ifNotNil: [^#globalVar]]] - ifNil: [(environment bindingOf: sym) ifNotNil: [^#globalVar]]]. - ^self resolvePartialPragmaArgument: aString! Item was removed: - ----- Method: SHParserST80>>scanBinary (in category 'scan') ----- - scanBinary - | c d | - c := self currentChar. - currentTokenSourcePosition := sourcePosition. - currentToken := c asString. - d := self nextChar. - ((self isSelectorCharacter: c) or: [c == $:]) ifFalse: [^currentToken]. - (c == $: and: [d == $=]) ifTrue: " := assignment" - [currentToken := currentToken , d asString. - self nextChar. - ^currentToken]. - ((c == $|) and: [self parsingBlockArguments]) ifTrue: - [^currentToken]. - [self isSelectorCharacter: d] whileTrue: - [currentToken := currentToken , d asString. - d := self nextChar]. - ^currentToken! Item was removed: - ----- Method: SHParserST80>>scanComment (in category 'scan') ----- - scanComment - - | start | - start := sourcePosition. - (sourcePosition := source indexOf: $" startingAt: start + 1) = 0 ifTrue: [ - sourcePosition := source size + 1. - ^self - addRangeType: #unfinishedComment start: start end: source size; - fail ]. - self - addRangeType: #comment start: start end: sourcePosition; - nextChar; - scanWhitespace! Item was removed: - ----- Method: SHParserST80>>scanIdentifier (in category 'scan') ----- - scanIdentifier - - | c | - currentTokenSourcePosition := sourcePosition. - [ - (c := self nextChar) isAlphaNumeric - or: [ c == $_ and: [ allowUnderscoreSelectors ] ] ] whileTrue. - (c == $: and: [ self peekChar ~~ $= ]) - ifTrue: [ self nextChar ]. - currentToken := source copyFrom: currentTokenSourcePosition to: sourcePosition - 1! Item was removed: - ----- Method: SHParserST80>>scanNext (in category 'scan') ----- - scanNext - - self scanWhitespace. - currentTokenType := nil. - currentTokenFirst := self currentChar ifNil: [ - " end of input " - currentTokenFirst := $ . - currentTokenSourcePosition := nil. - currentToken := nil. - ^nil ]. - currentTokenFirst isDigit ifTrue: [ ^self scanNumber ]. - (currentTokenFirst isLetter or: [ - currentTokenFirst == $_ and: [ allowUnderscoreSelectors ] ]) - ifTrue: [ ^self scanIdentifier ]. - ^self scanBinary! Item was removed: - ----- Method: SHParserST80>>scanNumber (in category 'scan') ----- - scanNumber - - | c | - currentTokenSourcePosition := sourcePosition. - self skipDigits. - (c := self currentChar) == $r - ifTrue: [ - | base | - base := (source copyFrom: currentTokenSourcePosition to: sourcePosition - 1) asUnsignedInteger. - base < 2 ifTrue: [ self fail ": radix must be greater than 1" ]. - self peekChar == $- ifTrue: [ self nextChar ]. - self skipDigitsBase: base. - (c := self currentChar) == $. ifTrue: [ - (self isDigit: self peekChar base: base) ifTrue: [ - self skipDigitsBase: base]. - c := self currentChar ] ] - ifFalse: [ - c == $. ifTrue: [ - self peekChar isDigit ifFalse: [ - ^currentToken := source copyFrom: currentTokenSourcePosition to: sourcePosition - 1 ]. - self skipDigits. - c := self currentChar ] ]. - c == $s - ifTrue: [ - (c := self nextChar) isDigit - ifFalse: [ c isLetter ifTrue: [sourcePosition := sourcePosition - 1 ] ] - ifTrue: [ self skipDigits ] ] - ifFalse: [ - (c == $d - or: [ c == $e - or: [ c == $q ] ]) - ifTrue: [ - ((c := self nextChar) isDigit or: [ c == $- and: [ self peekChar isDigit ] ]) - ifFalse: [ sourcePosition := sourcePosition - 1 ] - ifTrue: [ self skipDigits ] ] ]. - currentToken := source copyFrom: currentTokenSourcePosition to: sourcePosition - 1! Item was removed: - ----- Method: SHParserST80>>scanPast: (in category 'scan') ----- - scanPast: rangeType - "record rangeType for current token . - scan and answer the next token" - - ^self - addRangeType: rangeType; - scanNext! Item was removed: - ----- Method: SHParserST80>>scanPast:level: (in category 'scan') ----- - scanPast: rangeType level: level - "first level adds no suffix to the rangeType. - Suffix from 1 to 7 added in cycles , ((level-2) mod(7) + 1)" - | cycle typePlusCycle | - - cycle := level <= 1 - ifTrue: [0] - ifFalse:[ ((level - 2) \\ 7) + 1]. - typePlusCycle := cycle = 0 - ifTrue:[rangeType] - ifFalse:[(rangeType, cycle asString) asSymbol]. - ^self scanPast: typePlusCycle - ! Item was removed: - ----- Method: SHParserST80>>scanPast:start:end: (in category 'scan') ----- - scanPast: rangeType start: startInteger end: endInteger - "record rangeType for current token from startInteger to endInteger, - and scanNext token" - - ^self - addRangeType: rangeType start: startInteger end: endInteger; - scanNext - - ! Item was removed: - ----- Method: SHParserST80>>scanPastBracket: (in category 'scan') ----- - scanPastBracket: rangeType - "first level adds no suffix to the rangeType. - Suffix from 1 to 7 added in cycles , ((level-2) mod(7) + 1)" - - | rangeTypeForDepth | - rangeTypeForDepth := bracketDepth = 1 - ifTrue: [ rangeType ] - ifFalse: [ - (rangeType - caseOf: { - [ #blockStart ] -> [ #(blockStart1 blockStart2 blockStart3 blockStart4 blockStart5 blockStart6 blockStart7) ]. - [ #blockEnd ] -> [ #(blockEnd1 blockEnd2 blockEnd3 blockEnd4 blockEnd5 blockEnd6 blockEnd7) ]. - [ #leftParenthesis ] -> [ #(leftParenthesis1 leftParenthesis2 leftParenthesis3 leftParenthesis4 leftParenthesis5 leftParenthesis6 leftParenthesis7) ]. - [ #rightParenthesis ] -> [ #(rightParenthesis1 rightParenthesis2 rightParenthesis3 rightParenthesis4 rightParenthesis5 rightParenthesis6 rightParenthesis7) ] } - otherwise: [ self fail ": 'Unknown range type ', rangeType asString" ]) atWrap: bracketDepth - 1 ]. - self scanPast: rangeTypeForDepth - ! Item was removed: - ----- Method: SHParserST80>>scanWhitespace (in category 'scan') ----- - scanWhitespace - - (self currentChar ifNil: [ ^self ]) isSeparator ifTrue: [ - sourcePosition := source - indexOfAnyOf: CharacterSet nonSeparators - startingAt: sourcePosition + 1. - sourcePosition = 0 ifTrue: [ "Not found" - sourcePosition := source size + 1 ] ]. - self currentChar == $" ifTrue: [ self scanComment ]! Item was removed: - ----- Method: SHParserST80>>skipDigits (in category 'scan') ----- - skipDigits - - | c | - [ - (c := self nextChar asInteger) < 48 ifTrue: [ ^self ]. - c > 57 ifTrue: [ ^self ] ] repeat! Item was removed: - ----- Method: SHParserST80>>skipDigitsBase: (in category 'scan') ----- - skipDigitsBase: baseInteger - - [ self isDigit: self nextChar base: baseInteger ] whileTrue - ! Item was removed: - ----- Method: SHParserST80>>source (in category 'accessing') ----- - source - ^source! Item was removed: - ----- Method: SHParserST80>>source: (in category 'accessing') ----- - source: aStringOrText - - source := aStringOrText asString! Item was removed: - ----- Method: SHParserST80>>workspace: (in category 'accessing') ----- - workspace: aWorkspace - workspace := aWorkspace! Item was removed: - Object subclass: #SHRange - instanceVariableNames: 'start end type' - classVariableNames: '' - poolDictionaries: '' - category: 'ShoutCore-Parsing'! - - !SHRange commentStamp: 'tween 8/16/2004 15:16' prior: 0! - I associate a type with a range of characters in a String - I have these instance variables... - start - the one based index of the first character of the range within the String. - end - the one based index of the last character of the range within the String. - type - a Symbol describing the type of the range - - A sequence of instances of me are created by an instance of SHParserST80 which can then used by an instance of SHTextStyler to style Text. ! Item was removed: - ----- Method: SHRange class>>start:end:type: (in category 'instance creation') ----- - start: s end: e type: aSymbol - - ^self new - start: s end: e type: aSymbol; - yourself! Item was removed: - ----- Method: SHRange>>= (in category 'comparing') ----- - = anObject - - anObject class == SHRange ifFalse: [ ^false ]. - type = anObject type ifFalse: [ ^false ]. - start = anObject start ifFalse: [ ^false ]. - end = anObject end ifFalse: [ ^false ]. - ^true! Item was removed: - ----- Method: SHRange>>end (in category 'accessing') ----- - end - ^end! Item was removed: - ----- Method: SHRange>>end: (in category 'accessing') ----- - end: anInteger - end := anInteger! Item was removed: - ----- Method: SHRange>>hash (in category 'comparing') ----- - hash - - ^(((self class hash + type hash) hashMultiply + start) hashMultiply + end) hashMultiply! Item was removed: - ----- Method: SHRange>>length (in category 'accessing') ----- - length - ^end - start + 1! Item was removed: - ----- Method: SHRange>>printOn: (in category 'accessing') ----- - printOn: stream - - super printOn: stream. - stream - nextPut: $(; - print: type; - nextPutAll: ', '; - print: start; - nextPutAll: ', '; - print: end; - nextPut: $)! Item was removed: - ----- Method: SHRange>>start (in category 'accessing') ----- - start - ^start! Item was removed: - ----- Method: SHRange>>start: (in category 'accessing') ----- - start: anInteger - start := anInteger! Item was removed: - ----- Method: SHRange>>start:end:type: (in category 'accessing') ----- - start: startInteger end: endInteger type: typeSymbol - start := startInteger. - end := endInteger. - type := typeSymbol! Item was removed: - ----- Method: SHRange>>type (in category 'accessing') ----- - type - ^type! Item was removed: - ----- Method: SHRange>>type: (in category 'accessing') ----- - type: aSymbol - type := aSymbol! Item was removed: - Object subclass: #SHTextStyler - instanceVariableNames: 'backgroundProcess view stylingEnabled' - classVariableNames: '' - poolDictionaries: '' - category: 'ShoutCore-Styling'! - - !SHTextStyler commentStamp: 'tween 8/27/2004 10:54' prior: 0! - I am an Abstract class. - Subclasses of me can create formatted, coloured, and styled copies of Text that is given to them. - They may perform their styling asynchronously, in a background process which I create and manage. - - My public interface is... - - view: aViewOrMorph - set the view that will receive notifications when styling has completed. - - format: aText - modifies aText's string - - style: aText - modifies the TextAttributes of aText, but does not change the string, then sends #stylerStyled: to the view. - - styleInBackgroundProcess: aText - performs style: in a background process, then sends #stylerStylednBackground: to the view. - - styledTextFor: aText - answers a formatted and styled copy of aText - - unstyledTextFrom: aText - answers a copy of aText with all TextAttributes removed - - Subclasses of me should re-implement... - - privateFormat: aText - answer a formatted version of aText; the String may be changed - privateStyle: aText - modify the TextAttributes of aText; but do not change the String - - - - - ! Item was removed: - ----- Method: SHTextStyler>>evaluateWithoutStyling: (in category 'styling') ----- - evaluateWithoutStyling: aBlock - | t | - t := stylingEnabled. - stylingEnabled := false. - ^ aBlock ensure: [stylingEnabled := t]! Item was removed: - ----- Method: SHTextStyler>>format: (in category 'formatting') ----- - format: aText - "Answer a copy of <aText> which has been reformatted, - or <aText> if no formatting is to be applied" - - self terminateBackgroundStylingProcess. - ^self privateFormat: aText! Item was removed: - ----- Method: SHTextStyler>>initialize (in category 'styling') ----- - initialize - stylingEnabled := true - ! Item was removed: - ----- Method: SHTextStyler>>privateFormat: (in category 'private') ----- - privateFormat: aText - self shouldBeImplemented! Item was removed: - ----- Method: SHTextStyler>>privateStyle: (in category 'private') ----- - privateStyle: aText - - self shouldBeImplemented! Item was removed: - ----- Method: SHTextStyler>>style: (in category 'styling') ----- - style: aText - - | text | - self terminateBackgroundStylingProcess. - stylingEnabled ifFalse: [ ^self ]. - text := aText copy. - self privateStyle: text. - view stylerStyled: text! Item was removed: - ----- Method: SHTextStyler>>styleInBackgroundProcess: (in category 'styling') ----- - styleInBackgroundProcess: aText - - | text newBackgroundProcess | - self terminateBackgroundStylingProcess. - stylingEnabled ifFalse: [ ^self ]. - text := aText copy. - newBackgroundProcess := [ - self privateStyle: text. - Project current addDeferredUIMessage: [ - view stylerStyledInBackground: text ]. - Processor activeProcess == backgroundProcess ifTrue: [ - backgroundProcess := nil ] ] newProcess - priority: Processor userBackgroundPriority; - yourself. - backgroundProcess ifNil: [ - (backgroundProcess := newBackgroundProcess) resume ]! Item was removed: - ----- Method: SHTextStyler>>styledTextFor: (in category 'styling') ----- - styledTextFor: aText - "Answer a copy of aText that is both formatted and styled" - | formattedText | - - formattedText := self privateFormat: aText. - self privateStyle: formattedText. - ^formattedText! Item was removed: - ----- Method: SHTextStyler>>terminateBackgroundStylingProcess (in category 'private') ----- - terminateBackgroundStylingProcess - "Terminate the background styling process if it exists. Assume that the first two lines are executed atomically." - - backgroundProcess ifNotNil: [ :backgroundProcessToTerminate | - backgroundProcess := nil. - backgroundProcessToTerminate terminate ]! Item was removed: - ----- Method: SHTextStyler>>unstyledTextFrom: (in category 'styling') ----- - unstyledTextFrom: aText - - ^Text fromString: aText string! Item was removed: - ----- Method: SHTextStyler>>veryDeepInner: (in category 'copying') ----- - veryDeepInner: aDeepCopier - - super veryDeepInner: aDeepCopier. - backgroundProcess := nil. - view := view veryDeepCopyWith: aDeepCopier! Item was removed: - ----- Method: SHTextStyler>>view: (in category 'accessing') ----- - view: aViewOrMorph - view := aViewOrMorph! Item was removed: - SHTextStyler subclass: #SHTextStylerST80 - instanceVariableNames: 'classOrMetaClass workspace font parser formatAssignments environment sourceMap processedSourceMap pixelHeight attributesByPixelHeight parseAMethod context' - classVariableNames: 'EnforceItalicEmphasisInComments SyntaxHighlightingAsYouTypeAnsiAssignment SyntaxHighlightingAsYouTypeLeftArrowAssignment TextAttributesByPixelHeight' - poolDictionaries: '' - category: 'ShoutCore-Styling'! - - !SHTextStylerST80 commentStamp: 'tween 8/27/2004 10:55' prior: 0! - I style Smalltalk methods and expressions. - - My 'styleTable' class instance var holds an array ofArrays which control how each token is styled/coloured. See my defaultStyleTable class method for its structure. - My styleTable can be changed by either modifying the defaultStyleTable class method and then executing SHTextStylerST80 initialize ; or by giving me a new styleTable through my #styleTable: class method. - - My 'textAttributesByPixelSize' class instance var contains a dictionary of dictionaries. - The key is a pixelSize and the value a Dictionary from token type Symbol to TextAttribute array. - It is created/maintained automatically. - - I also install these 3 preferences when my class initialize method is executed.... - #syntaxHighlightingAsYouType - controls whether methods are styled in browsers - #syntaxHighlightingAsYouTypeAnsiAssignment - controls whether assignments are formatted to be := - #syntaxHighlightingAsYouTypeLeftArrowAssignment - controls whether assignments are formatted to be _ - - I reimplement #unstyledTextFrom: so that TextActions are preserved in the unstyled text - - - - - - - ! Item was removed: - ----- Method: SHTextStylerST80 class>>ansiAssignmentPreferenceChanged (in category 'preferences') ----- - ansiAssignmentPreferenceChanged - "the user has changed the syntaxHighlightingAsYouTypeAnsiAssignment setting. - If they have turned it on then force syntaxHighlightingAsYouTypeLeftArrowAssignment - to be turned off" - self syntaxHighlightingAsYouTypeAnsiAssignment - ifTrue: [self syntaxHighlightingAsYouTypeLeftArrowAssignment: false]! Item was removed: - ----- Method: SHTextStylerST80 class>>applyUserInterfaceTheme (in category 'preferences') ----- - applyUserInterfaceTheme - - self resetTextAttributesByPixelHeight.! Item was removed: - ----- Method: SHTextStylerST80 class>>enforceItalicEmphasisInComments (in category 'preferences') ----- - enforceItalicEmphasisInComments - <preference: 'Enforce Italic in Comments' - categoryList: #(browsing Accessibility) - description: 'When enabled, always typeset source-code comments in italic, regardless of the current UI theme. When disabled, depend on what the current UI theme prescribes as text attributes for such comments.' - type: #Boolean> - - ^ EnforceItalicEmphasisInComments ifNil: [true]! Item was removed: - ----- Method: SHTextStylerST80 class>>enforceItalicEmphasisInComments: (in category 'preferences') ----- - enforceItalicEmphasisInComments: aBooleanOrNil - - EnforceItalicEmphasisInComments = aBooleanOrNil ifTrue: [^ self]. - EnforceItalicEmphasisInComments := aBooleanOrNil. - - self userInterfaceTheme apply. "Invalidate all styling caches." - ! Item was removed: - ----- Method: SHTextStylerST80 class>>initialize (in category 'class initialization') ----- - initialize - - TextStyler register: self for: #Smalltalk.! Item was removed: - ----- Method: SHTextStylerST80 class>>leftArrowAssignmentPreferenceChanged (in category 'preferences') ----- - leftArrowAssignmentPreferenceChanged - "the user has changed the syntaxHighlightingAsYouTypeLeftArrowAssignment setting. - If they have turned it on then force syntaxHighlightingAsYouTypeAnsiAssignment - to be turned off" - self syntaxHighlightingAsYouTypeLeftArrowAssignment - ifTrue: [self syntaxHighlightingAsYouTypeAnsiAssignment: false]! Item was removed: - ----- Method: SHTextStylerST80 class>>resetTextAttributesByPixelHeight (in category 'style table') ----- - resetTextAttributesByPixelHeight - - TextAttributesByPixelHeight := nil.! Item was removed: - ----- Method: SHTextStylerST80 class>>syntaxHighlightingAsYouType (in category 'preferences') ----- - syntaxHighlightingAsYouType - <preference: 'syntaxHighlightingAsYouType' - categoryList: #(browsing Accessibility) - description: 'Enable, or disable, Shout - Syntax Highlighting As You Type. When enabled, code in Browsers and Workspaces is styled to reveal its syntactic structure. When the code is changed (by typing some characters, for example), the styling is changed so that it remains in sync with the modified code.' - type: #Boolean> - - ^ (TextStyler for: #Smalltalk) = self! Item was removed: - ----- Method: SHTextStylerST80 class>>syntaxHighlightingAsYouType: (in category 'preferences') ----- - syntaxHighlightingAsYouType: aBoolean - - self syntaxHighlightingAsYouType = aBoolean ifTrue: [^ self]. - - TextStyler - default: (aBoolean ifTrue: [self] ifFalse: [nil]) - for: #Smalltalk. - - "Update known tools that show Smalltalk source code." - (self environment classNamed: #PluggableTextMorphPlus) ifNotNil: [:widgetClass | - | stylerClass toolClass workspaceClass | - stylerClass := TextStyler for: #Smalltalk. - toolClass := self environment classNamed: #CodeHolder. - workspaceClass := self environment classNamed: #Workspace. "Actually a StringHolder but a code tool." - widgetClass allInstancesDo: [:widget | - ((widget model isKindOf: toolClass) and: [widget getTextSelector ~= #annotation]) - ifTrue: [ - widget styler: (stylerClass ifNotNil: [:c | c new view: widget]). - widget setText: widget text asString asText makeSelectorBold "drop text attributes; keep method signature styled" ]. - (widget model isKindOf: workspaceClass) - ifTrue: [ - widget styler: (stylerClass ifNotNil: [:c | c new view: widget]). - widget setText: widget text asString "drop text attributes"] ]].! Item was removed: - ----- Method: SHTextStylerST80 class>>syntaxHighlightingAsYouTypeAnsiAssignment (in category 'preferences') ----- - syntaxHighlightingAsYouTypeAnsiAssignment - <preference: 'syntaxHighlightingAsYouTypeAnsiAssignment' - category: 'browsing' - description: 'If true, and syntaxHighlightingAsYouType is enabled, all left arrow assignments ( _ ) will be converted to the ANSI format ( := ) when a method is selected in a Browser. Whilst editing a method, this setting has no effect - both the left arrow and the ansi format may be used.' - type: #Boolean> - ^SyntaxHighlightingAsYouTypeAnsiAssignment ifNil: [true]! Item was removed: - ----- Method: SHTextStylerST80 class>>syntaxHighlightingAsYouTypeAnsiAssignment: (in category 'preferences') ----- - syntaxHighlightingAsYouTypeAnsiAssignment: aBooleanOrNil - - SyntaxHighlightingAsYouTypeAnsiAssignment := aBooleanOrNil. - - aBooleanOrNil == true - ifTrue: [SyntaxHighlightingAsYouTypeLeftArrowAssignment := false].! Item was removed: - ----- Method: SHTextStylerST80 class>>syntaxHighlightingAsYouTypeLeftArrowAssignment (in category 'preferences') ----- - syntaxHighlightingAsYouTypeLeftArrowAssignment - <preference: 'syntaxHighlightingAsYouTypeLeftArrowAssignment' - category: 'browsing' - description: 'If true, and syntaxHighlightingAsYouType is enabled, all ANSI format assignments ( := ) will be converted to left arrows ( _ ) when a method is selected in a Browser. Whilst editing a method, this setting has no effect - both the left arrow and the ansi format may be used.' - type: #Boolean> - ^SyntaxHighlightingAsYouTypeLeftArrowAssignment ifNil: [false]! Item was removed: - ----- Method: SHTextStylerST80 class>>syntaxHighlightingAsYouTypeLeftArrowAssignment: (in category 'preferences') ----- - syntaxHighlightingAsYouTypeLeftArrowAssignment: aBooleanOrNil - - SyntaxHighlightingAsYouTypeLeftArrowAssignment := aBooleanOrNil. - - aBooleanOrNil == true - ifTrue: [SyntaxHighlightingAsYouTypeAnsiAssignment := false].! Item was removed: - ----- Method: SHTextStylerST80 class>>textAttributesByPixelHeight (in category 'style table') ----- - textAttributesByPixelHeight - "A cache for text attributes used by all instances of text styler." - ^ TextAttributesByPixelHeight ifNil: [ TextAttributesByPixelHeight := Dictionary new ]! Item was removed: - ----- Method: SHTextStylerST80 class>>textAttributesByPixelHeightAt:put: (in category 'style table') ----- - textAttributesByPixelHeightAt: aNumber put: someTextAttributes - "Thread-safety first." - - TextAttributesByPixelHeight := self textAttributesByPixelHeight copy - at: aNumber put: someTextAttributes; - yourself. - ^ someTextAttributes! Item was removed: - ----- Method: SHTextStylerST80 class>>themePriority (in category 'preferences') ----- - themePriority - - ^ 65! Item was removed: - ----- Method: SHTextStylerST80 class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ { - { #default. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #invalid. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #excessCode. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #comment. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #unfinishedComment. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #'$'. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #character. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #integer. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #number. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #-. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #symbol. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #stringSymbol. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #literalArray. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #string. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #unfinishedString. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #assignment. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #ansiAssignment. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #literal. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #keyword. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #binary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #unary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #incompleteKeyword. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #incompleteBinary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #incompleteUnary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #undefinedKeyword. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #undefinedBinary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #undefinedUnary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #patternKeyword. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #patternBinary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #patternUnary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #self. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #super. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #true. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #false. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #nil. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #thisContext. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #return. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #patternArg. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #methodArg. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockPatternArg. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockArg. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #argument. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockArgColon. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis2. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis2. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis3. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis3. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis4. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis4. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis5. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis5. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis6. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis6. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftParenthesis7. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightParenthesis7. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart2. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd2. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart3. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd3. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart4. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd4. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart5. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd5. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart6. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd6. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockStart7. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockEnd7. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #arrayStart. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #arrayEnd. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #arrayStart1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #arrayEnd1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #byteArrayStart. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #byteArrayEnd. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #byteArrayStart1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #byteArrayEnd1. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #leftBrace. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #rightBrace. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #cascadeSeparator. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #statementSeparator. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #externalCallType. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #externalCallTypePointerIndicator. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #primitiveOrExternalCallStart. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #primitiveOrExternalCallEnd. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #methodTempBar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockTempBar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockArgsBar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #primitive. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #pragmaKeyword. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #pragmaUnary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #pragmaBinary. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #externalFunctionCallingConvention. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #module. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockTempVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #blockPatternTempVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #instVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #workspaceVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #undefinedIdentifier. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #incompleteIdentifier. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #tempVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #patternTempVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #poolConstant. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #classVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - { #globalVar. 'Styling'. 'Specify color, emphasis, and font in a triple.' }. - }! Item was removed: - ----- Method: SHTextStylerST80 class>>unload (in category 'class initialization') ----- - unload - - TextStyler unregister: self for: #Smalltalk.! Item was removed: - ----- Method: SHTextStylerST80>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - "My dependents should take care of invalidating my caches and then ask me to style again. It is of no use to invalidate my caches right now because I have no idea when my dependents will ask me to style again."! Item was removed: - ----- Method: SHTextStylerST80>>attributesByPixelHeight (in category 'style table') ----- - attributesByPixelHeight - - ^ attributesByPixelHeight ifNil: [ - attributesByPixelHeight := self attributesByPixelHeight: self pixelHeight]! Item was removed: - ----- Method: SHTextStylerST80>>attributesByPixelHeight: (in category 'style table') ----- - attributesByPixelHeight: aNumber - - ^ self class textAttributesByPixelHeight - at: aNumber - ifAbsent: [ - self class - textAttributesByPixelHeightAt: aNumber - put: (self createTextAttributesForPixelHeight: aNumber)]! Item was removed: - ----- Method: SHTextStylerST80>>attributesFor: (in category 'style table') ----- - attributesFor: aSymbol - - ^ self attributesByPixelHeight at: aSymbol ifAbsent: nil! Item was removed: - ----- Method: SHTextStylerST80>>canApplyUserInterfaceTheme (in category 'updating') ----- - canApplyUserInterfaceTheme - - ^ false! Item was removed: - ----- Method: SHTextStylerST80>>classOrMetaClass: (in category 'accessing') ----- - classOrMetaClass: aBehavior - classOrMetaClass := aBehavior! Item was removed: - ----- Method: SHTextStylerST80>>context: (in category 'accessing') ----- - context: aContext - context := aContext! Item was removed: - ----- Method: SHTextStylerST80>>convertAssignmentsToAnsi: (in category 'private') ----- - convertAssignmentsToAnsi: aText - "If the Preference is to show ansiAssignments then answer a copy of <aText> where each left arrow assignment is replaced with a ':=' ansi assignment. A parser is used so that each left arrow is only replaced if it occurs within an assigment statement" - - ^self replaceStringForRangesWithType: #assignment with: ':=' in: aText! Item was removed: - ----- Method: SHTextStylerST80>>convertAssignmentsToLeftArrow: (in category 'private') ----- - convertAssignmentsToLeftArrow: aText - "If the Preference is to show leftArrowAssignments then answer a copy of <aText> where each ansi assignment (:=) is replaced with a left arrow. A parser is used so that each ':=' is only replaced if it actually occurs within an assigment statement" - - ^self replaceStringForRangesWithType: #ansiAssignment with: '_' in: aText! Item was removed: - ----- Method: SHTextStylerST80>>createAttributeArrayForColor:emphasis:font: (in category 'style table') ----- - createAttributeArrayForColor: aColorOrNil emphasis: anEmphasisOrArrayorNil font: aFontOrNil - "Answer a new Array containing any non nil TextAttributes specified" - - | answer emphArray | - answer := Array new. - aColorOrNil ifNotNil: [answer := answer, {TextColor color: aColorOrNil}]. - anEmphasisOrArrayorNil ifNotNil: [ - emphArray := anEmphasisOrArrayorNil isArray - ifFalse: [{anEmphasisOrArrayorNil}] - ifTrue: [anEmphasisOrArrayorNil]. - answer := answer, emphArray]. - aFontOrNil ifNotNil: [ - answer := answer, {TextFontReference toFont: aFontOrNil}]. - ^answer! Item was removed: - ----- Method: SHTextStylerST80>>createTextAttributesForPixelHeight: (in category 'style table') ----- - createTextAttributesForPixelHeight: aNumber - - | result | - result := IdentityDictionary new. - result at: #default put: {}. "Required as fall-back for non-existing attributes." - - self class themeProperties do: [:each | - | spec element emphasis font color | - element := each first. - spec := self userInterfaceTheme perform: element. - spec isArray ifFalse: [spec := {spec}]. "Support color-only hints." - - color := spec first ifNotNil: [:colorSpec | Color colorFrom: colorSpec]. - emphasis := spec at: 2 ifAbsent:[nil]. - font := spec at: 3 ifAbsent: [nil]. - - (element == #comment and: [self class enforceItalicEmphasisInComments]) - ifTrue: [ - emphasis - ifNil: [emphasis := TextEmphasis italic] - ifNotNil: [ - emphasis isArray - ifFalse: [emphasis := {emphasis}, {TextEmphasis italic}] - ifTrue: [emphasis := emphasis, {TextEmphasis italic}]. - emphasis := emphasis asSet asArray "no double italic"]]. - - "Support for named text styles." - font isString ifTrue: [ - | textStyle | - textStyle := TextStyle named: font. - font := textStyle ifNotNil: [textStyle fontOfSize: aNumber]]. - - (self createAttributeArrayForColor: color emphasis: emphasis font: font) - ifNotEmpty: [:attrArray | result at: element put: attrArray]]. - ^ result! Item was removed: - ----- Method: SHTextStylerST80>>environment: (in category 'accessing') ----- - environment: anObject - environment := anObject! Item was removed: - ----- Method: SHTextStylerST80>>font: (in category 'accessing') ----- - font: aFont - font := aFont! Item was removed: - ----- Method: SHTextStylerST80>>formatAssignments: (in category 'accessing') ----- - formatAssignments: aBoolean - "determines whether assignments are reformatted according to the Preferences, - or left as they are" - formatAssignments := aBoolean! Item was removed: - ----- Method: SHTextStylerST80>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - formatAssignments := true! Item was removed: - ----- Method: SHTextStylerST80>>parseAMethod: (in category 'accessing') ----- - parseAMethod: aBoolean - - parseAMethod := aBoolean! Item was removed: - ----- Method: SHTextStylerST80>>parseableSourceCodeTemplate (in category 'private') ----- - parseableSourceCodeTemplate - - ^'messageSelectorAndArgumentNames - "comment stating purpose of message" - - | temporary variable names | - statements'! Item was removed: - ----- Method: SHTextStylerST80>>pixelHeight (in category 'private') ----- - pixelHeight - "In Morphic the receiver will have been given a code font, in MVC the font will be nil. So when the font is nil, answer the pixelHeight of the MVC Browsers' code font, i.e. TextStyle defaultFont pixelHeight" - ^pixelHeight - ifNil:[pixelHeight := (font - ifNil:[TextStyle defaultFont]) pixelSize]! Item was removed: - ----- Method: SHTextStylerST80>>privateFormat: (in category 'private') ----- - privateFormat: aText - "Perform any formatting of aText necessary and answer either aText, or a formatted copy of aText" - - aText asString = Object sourceCodeTemplate - ifTrue:[ - "the original source code template does not parse, - replace it with one that does" - ^self parseableSourceCodeTemplate asText]. - formatAssignments - ifTrue:[ - self class syntaxHighlightingAsYouTypeAnsiAssignment - ifTrue:[^self convertAssignmentsToAnsi: aText]. - self class syntaxHighlightingAsYouTypeLeftArrowAssignment - ifTrue:[^self convertAssignmentsToLeftArrow: aText]]. - ^aText! Item was removed: - ----- Method: SHTextStylerST80>>privateStyle: (in category 'private') ----- - privateStyle: aText - - | ranges | - ranges := self rangesIn: aText setWorkspace: true. - ranges ifNotNil: [self setAttributesIn: aText fromRanges: ranges]! Item was removed: - ----- Method: SHTextStylerST80>>rangesIn:setWorkspace: (in category 'private') ----- - rangesIn: aText setWorkspace: aBoolean - "Answer a collection of SHRanges by parsing aText. - When formatting it is not necessary to set the workspace, and this can make the parse take less time, so aBoolean specifies whether the parser should be given the workspace" - - | shoutParserClass | - "Switch parsers if we have to" - shoutParserClass := (classOrMetaClass ifNil:[Object]) shoutParserClass. - parser class == shoutParserClass ifFalse:[parser := shoutParserClass new]. - parser parseAMethod: parseAMethod. - ^parser - rangesIn: aText asString - classOrMetaClass: classOrMetaClass - workspace: (aBoolean ifTrue:[workspace]) - environment: environment - context: context! Item was removed: - ----- Method: SHTextStylerST80>>replaceStringForRangesWithType:with:in: (in category 'private') ----- - replaceStringForRangesWithType: aSymbol with: aString in: aText - "Answer aText if no replacements, or a copy of aText with - each range with a type of aSymbol replaced by aString" - - | answer rangesToReplace adjustSourceMap increaseInLength stringSize | - rangesToReplace := self rangesIn: aText setWorkspace: false. - rangesToReplace removeAllSuchThat: [ :range | range type ~~ aSymbol ]. - rangesToReplace isEmpty ifTrue: [^aText]. - answer := aText copy. - increaseInLength := 0. - adjustSourceMap := sourceMap notNil and:[sourceMap ~~ processedSourceMap]. - (rangesToReplace isSortedBy: [ :a :b | a start <= b start ]) ifFalse: [ - "Can this ever happen?" - rangesToReplace sort: [ :a :b | a start <= b start ] ]. - stringSize := aString size. - rangesToReplace do: [ :range | - | end start thisIncrease | - start := range start + increaseInLength. - end := range end + increaseInLength. - answer replaceFrom: start to: end with: aString. - thisIncrease := stringSize - range length. - increaseInLength := increaseInLength + thisIncrease. - adjustSourceMap ifTrue: [ - sourceMap do: [ :association | - | first newFirst last newLast | - first := newFirst := association value first. - last := newLast := association value last. - first > start ifTrue: [ newFirst := first + thisIncrease ]. - last > start ifTrue: [ newLast := last + thisIncrease ]. - (first ~= newFirst or: [ last ~= newLast ]) - ifTrue:[ association value: (newFirst to: newLast) ] ] ] ]. - adjustSourceMap ifTrue:[processedSourceMap := sourceMap]. - ^answer! Item was removed: - ----- Method: SHTextStylerST80>>reset (in category 'initialize-release') ----- - reset - - attributesByPixelHeight := nil.! Item was removed: - ----- Method: SHTextStylerST80>>setAttributesIn:fromRanges: (in category 'private') ----- - setAttributesIn: aText fromRanges: ranges - - | defaultAttributes newRuns newValues lastAttributes oldRuns nextIndex lastCount | - oldRuns := aText runs. - defaultAttributes := self attributesFor: #default. - newRuns := OrderedCollection new: ranges size * 2 + 1. - newValues := OrderedCollection new: ranges size * 2 + 1. - lastAttributes := nil. - nextIndex := 1. - lastCount := 0. - ranges do: [ :range | - | attributes | - nextIndex < range start ifTrue: [ - lastAttributes == defaultAttributes - ifTrue: [ - lastCount := lastCount + range start - nextIndex. - newRuns at: newRuns size put: lastCount ] - ifFalse: [ - lastCount := range start - nextIndex. - newRuns addLast: lastCount. - lastAttributes := defaultAttributes. - newValues addLast: lastAttributes ]. - nextIndex := range start ]. - attributes := (self attributesFor: range type) ifNil: [ defaultAttributes ]. - lastAttributes == attributes - ifTrue: [ - lastCount := lastCount + range end - nextIndex + 1. - newRuns at: newRuns size put: lastCount ] - ifFalse: [ - lastCount := range end - nextIndex + 1. - newRuns addLast: lastCount. - lastAttributes := attributes. - newValues addLast: lastAttributes ]. - nextIndex := range end + 1 ]. - nextIndex <= aText size ifTrue: [ - lastAttributes == defaultAttributes - ifTrue: [ - lastCount := lastCount + aText size - nextIndex + 1. - newRuns at: newRuns size put: lastCount ] - ifFalse: [ - lastCount := aText size - nextIndex + 1. - newRuns addLast: lastCount. - lastAttributes := defaultAttributes. - newValues addLast: lastAttributes ] ]. - aText runs: (RunArray runs: newRuns values: newValues). - oldRuns withStartStopAndValueDo: [ :start :stop :attribs | - (attribs anySatisfy: [ :each | each shoutShouldPreserve ]) ifTrue: [ - attribs do: [ :each | aText addAttribute: each from: start to: stop ] ] ]. - ! Item was removed: - ----- Method: SHTextStylerST80>>sourceMap: (in category 'accessing') ----- - sourceMap: aSortedCollection - "set the receiver's sourceMap to aSortedCollection. - The sourceMap is used by a Debugger to select the appropriate - ranges within its text. These ranges need to be adjusted if, and when, the receiver - reformats the text that is displayed" - - sourceMap := aSortedCollection! Item was removed: - ----- Method: SHTextStylerST80>>unstyledTextFrom: (in category 'converting') ----- - unstyledTextFrom: aText - "Re-implemented so that TextActions are not removed from aText" - | answer | - answer := super unstyledTextFrom: aText. - aText runs withStartStopAndValueDo: [:start :stop :attribs | - (attribs anySatisfy: [:each | each shoutShouldPreserve]) - ifTrue: [ - attribs do: [:eachAttrib | answer addAttribute: eachAttrib from: start to: stop]]]. - ^answer! Item was removed: - ----- Method: SHTextStylerST80>>veryDeepInner: (in category 'copying') ----- - veryDeepInner: aDeepCopier - super veryDeepInner: aDeepCopier. - classOrMetaClass := classOrMetaClass veryDeepCopyWith: aDeepCopier. - workspace := workspace veryDeepCopyWith: aDeepCopier. - "share the font?" - parser := parser veryDeepCopyWith: aDeepCopier. - sourceMap := sourceMap veryDeepCopyWith: aDeepCopier. - processedSourceMap := processedSourceMap veryDeepCopyWith: aDeepCopier! Item was removed: - ----- Method: SHTextStylerST80>>workspace: (in category 'accessing') ----- - workspace: aWorkspace - workspace := aWorkspace! Item was removed: - ----- Method: SmalltalkImage>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - "Answer true if the receiver has a key that begins with aString, false otherwise" - - ^globals hasBindingThatBeginsWith: aString! Item was removed: - ----- Method: SystemDictionary>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - "Use the cached class and non-class names for better performance." - - | name searchBlock | - searchBlock := [ :element | - (element beginsWith: aString) - ifTrue: [ 0 ] - ifFalse: [ - aString < element - ifTrue: [ -1 ] - ifFalse: [ 1 ] ] ]. - name := self classNames - findBinary: searchBlock - ifNone: [ nil ]. - name ifNotNil: [ ^true ]. - name := self nonClassNames - findBinary: searchBlock - ifNone: [ nil ]. - ^name notNil! Item was removed: - ----- Method: TextAction>>shoutShouldPreserve (in category '*ShoutCore') ----- - shoutShouldPreserve - - ^true! Item was removed: - ----- Method: TextAttribute>>shoutShouldPreserve (in category '*ShoutCore') ----- - shoutShouldPreserve - - ^false! Item was removed: - ----- Method: Workspace>>hasBindingThatBeginsWith: (in category '*ShoutCore') ----- - hasBindingThatBeginsWith: aString - - bindings ifNil: [ ^false ]. - bindings keysDo: [ :each | - (each beginsWith: aString) ifTrue: [ ^true ] ]. - ^false! Item was removed: - (PackageInfo named: 'ShoutCore') postscript: 'SHTextStylerST80 enforceItalicEmphasisInComments: true.'!
More information about the Squeak-dev mailing list |