'From Squeak3.1alpha of 5 February 2001 [latest update: #4102] on 29 May 2001 at 2:50:22 pm'! "Change Set: symbolGoof Date: 29 May 2001 Author: Bob Arning Fix a few recent goof relating to enumeration of symbols and the method finder"! !MethodReference methodsFor: 'as yet unclassified' stamp: 'RAA 5/29/2001 14:44'! stringVersion ^stringVersion! ! !MethodReference methodsFor: 'as yet unclassified' stamp: 'RAA 5/29/2001 14:44'! stringVersion: aString stringVersion _ aString! ! !SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'RAA 5/29/2001 14:45'! markMatchingClasses "If an example is used, mark classes matching the example instance with an asterisk." | unmarkedClassList firstPartOfSelector receiverString receiver | self flag: #mref. "allows for old-fashioned style" "Only 'example' queries can be marked." (contents asString includes: $.) ifFalse: [^ self]. unmarkedClassList _ classList copy. "Get the receiver object of the selected statement in the message list." firstPartOfSelector _ (Scanner new scanTokens: (selectorList at: selectorIndex)) second. receiverString _ (ReadStream on: (selectorList at: selectorIndex)) upToAll: firstPartOfSelector. receiver _ Compiler evaluate: receiverString. unmarkedClassList do: [ :classAndMethod | | class | (classAndMethod isKindOf: MethodReference) ifTrue: [ (receiver isKindOf: classAndMethod actualClass) ifTrue: [ classAndMethod stringVersion: '*', classAndMethod stringVersion.. ] ] ifFalse: [ class _ Compiler evaluate: ((ReadStream on: classAndMethod) upToAll: firstPartOfSelector). (receiver isKindOf: class) ifTrue: [ classList add: '*', classAndMethod. classList remove: classAndMethod ] ]. ]. ! ! !SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'RAA 5/29/2001 14:39'! selectedClass "Answer the currently selected class." | pairString | self flag: #mref. "allows for old-fashioned style" classListIndex = 0 ifTrue: [^nil]. pairString _ classList at: classListIndex. (pairString isKindOf: MethodReference) ifTrue: [ ^pairString actualClass ]. (pairString includes: $*) ifTrue: [pairString _ pairString allButFirst]. MessageSet parse: pairString toClassAndSelector: [:cls :sel | ^ cls].! ! !Symbol class methodsFor: 'access' stamp: 'RAA 5/29/2001 14:34'! selectorsContaining: aString "Answer a list of selectors that contain aString within them. Case-insensitive. Does return symbols that begin with a capital letter." | size selectorList ascii | selectorList _ OrderedCollection new. (size _ aString size) = 0 ifTrue: [^selectorList]. aString size = 1 ifTrue: [ ascii _ aString first asciiValue. ascii < 128 ifTrue: [selectorList add: (OneCharacterSymbols at: ascii+1)] ]. aString first isLetter ifFalse: [ aString size == 2 ifTrue: [Symbol hasInterned: aString ifTrue: [:s | selectorList add: s]]. ^selectorList ]. selectorList _ selectorList copyFrom: 2 to: selectorList size. self allSymbolTablesDo: [:each | each size >= size ifTrue: [(each findSubstring: aString in: each startingAt: 1 matchTable: CaseInsensitiveOrder) > 0 ifTrue: [selectorList add: each]]]. ^selectorList reject: [:each | "reject non-selectors, but keep ones that begin with an uppercase" each numArgs < 0 and: [each asString withFirstCharacterDownshifted numArgs < 0]]. "Symbol selectorsContaining: 'scon'"! ! !Symbol class methodsFor: 'access' stamp: 'RAA 5/29/2001 14:35'! thatStarts: leadingCharacters skipping: skipSym "Answer a selector symbol that starts with leadingCharacters. Symbols beginning with a lower-case letter handled directly here. Ignore case after first char. If skipSym is not nil, it is a previous answer; start searching after it. If no symbols are found, answer nil. Used by Alt-q (Command-q) routines" | size firstMatch key | size _ leadingCharacters size. size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]]. firstMatch _ leadingCharacters at: 1. size > 1 ifTrue: [key _ leadingCharacters copyFrom: 2 to: size]. self allSymbolTablesDo: [:each | each size >= size ifTrue: [ ((each at: 1) == firstMatch and: [key == nil or: [(each findString: key startingAt: 2 caseSensitive: false) = 2]]) ifTrue: [^each] ] ] after: skipSym. ^nil "Symbol thatStarts: 'sf' skipping: nil" "Symbol thatStarts: 'sf' skipping: #sfpGetFile:with:with:with:with:with:with:with:with:" "Symbol thatStarts: 'candidate' skipping: nil" ! ! !Symbol class methodsFor: 'class initialization' stamp: 'RAA 5/29/2001 14:35'! allSymbolTablesDo: aBlock after: aSymbol NewSymbols do: aBlock after: aSymbol. SymbolTable do: aBlock after: aSymbol.! ! !Symbol class methodsFor: 'private' stamp: 'RAA 5/29/2001 14:33'! possibleSelectorsFor: misspelled "Answer an ordered collection of possible corrections for the misspelled selector in order of likelyhood" | numArgs candidates lookupString best binary short long first ss | lookupString _ misspelled asLowercase. "correct uppercase selectors to lowercase" numArgs _ lookupString numArgs. (numArgs < 0 or: [lookupString size < 2]) ifTrue: [^ OrderedCollection new: 0]. first _ lookupString first. short _ lookupString size - (lookupString size // 4 max: 3) max: 2. long _ lookupString size + (lookupString size // 4 max: 3). "First assemble candidates for detailed scoring" candidates _ OrderedCollection new. self allSymbolTablesDo: [:s | (((ss _ s size) >= short "not too short" and: [ss <= long "not too long" or: [(s at: 1) = first]]) "well, any length OK if starts w/same letter" and: [s numArgs = numArgs]) "and numArgs is the same" ifTrue: [candidates add: s]]. "Then further prune these by correctAgainst:" best _ lookupString correctAgainst: candidates. ((misspelled last ~~ $:) and: [misspelled size > 1]) ifTrue: [ binary _ misspelled, ':'. "try for missing colon" Symbol hasInterned: binary ifTrue: [:him | best addFirst: him]]. ^ best! !