--- a/Scanner.st Mon May 09 09:25:48 2005 +0200
+++ b/Scanner.st Wed Jun 15 12:42:23 2005 +0200
@@ -23,7 +23,7 @@
warnOldStyleAssignment warnCommonMistakes outStream outCol
warnSTXNameSpaceUse warnPossibleIncompatibilities
warnDollarInIdentifier inArrayLiteral
- allowLiteralNameSpaceSymbols'
+ allowLiteralNameSpaceSymbols lastDirective'
classVariableNames:'TypeArray ActionArray Warnings EmptySourceNotificationSignal
WarnSTXSpecials WarnOldStyleAssignment WarnUnderscoreInIdentifier
WarnCommonMistakes WarnPossibleIncompatibilities
@@ -43,6 +43,27 @@
privateIn:Scanner
!
+Object subclass:#Directive
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Scanner
+!
+
+Scanner::Directive subclass:#ClassDirective
+ instanceVariableNames:'className'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Scanner::Directive
+!
+
+Scanner::Directive::ClassDirective subclass:#ClassHintDirective
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Scanner::Directive
+!
+
Query subclass:#DoNotShowCompilerWarningAgainActionQuery
instanceVariableNames:''
classVariableNames:''
@@ -796,10 +817,43 @@
!Scanner methodsFor:'directives'!
+parseClassDirective
+ "
+ Class: className
+ "
+
+ |className|
+
+ className := self parseDirectiveClassNameArg.
+ className isNil ifTrue:[
+ Transcript showCR:'unrecognized ''Class'' directive'.
+ ^ false
+ ].
+ lastDirective := Directive newClassDirective className:className.
+ ^ true
+!
+
+parseClassHintDirective
+ "
+ ClassHint: className
+ "
+
+ |className|
+
+ className := self parseDirectiveClassNameArg.
+ className isNil ifTrue:[
+ Transcript showCR:'unrecognized ''ClassHint'' directive'.
+ ^ false
+ ].
+ lastDirective := Directive newClassHintDirective className:className.
+ ^ true
+!
+
parseDirective
- "parse a directive - this is an ST/X special"
-
- |directive packageName namespace list syntax|
+ "parse a directive inside a comment (introduced with '{').
+ This is an ST/X special"
+
+ |directive|
source next.
source skipSeparatorsExceptCR.
@@ -812,23 +866,11 @@
hereChar := source peekOrNil.
"
- package: 'name-of-package'
- package: packageId
+ Package: 'name-of-package'
+ Package: packageId
"
directive = 'package' ifTrue:[
- packageName := self parseDirectiveStringArg.
- packageName notNil ifTrue:[
- packageName := packageName asSymbol.
- (requestor notNil
- and:[requestor respondsTo:#setPackage:]) ifTrue:[
- requestor setPackage:packageName
- ] ifFalse:[
- self setPackage:packageName
- ].
- ] ifFalse:[
- Transcript showCR:'unrecognized ''package'' directive'.
- ^ false
- ]
+ self parsePackageDirective.
].
"
@@ -836,18 +878,7 @@
Namespace: nameSpaceIdentifier
"
(directive = 'namespace') ifTrue:[
- namespace := self parseDirectiveStringArg.
- namespace notNil ifTrue:[
- (requestor notNil
- and:[requestor respondsTo:#setNameSpace:]) ifTrue:[
- requestor setNameSpace:namespace
- ] ifFalse:[
- self setNameSpace:namespace
- ].
- ] ifFalse:[
- Transcript showCR:'unrecognized ''namespace'' directive'.
- ^ false
- ].
+ self parseNamespaceDirective.
].
"
@@ -855,50 +886,34 @@
Uses: nameSpaceId1, ... , nameSpaceIdN
"
directive = 'uses' ifTrue:[
- list := self parseDirectiveStringListArg.
- list notNil ifTrue:[
- (requestor notNil
- and:[requestor respondsTo:#addNameSpaces:]) ifTrue:[
- requestor addNameSpaces:list
- ]
- ] ifFalse:[
- Transcript showCR:'unrecognized ''uses'' directive'.
- ^ false
- ]
+ self parseUsesDirective.
].
"
Prerequisites: 'name-of-package', ... , 'name-of-package'
"
directive = 'prerequisites' ifTrue:[
- list := self parseDirectiveStringListArg.
- list notNil ifTrue:[
- (requestor notNil
- and:[requestor respondsTo:#requirePackages:]) ifTrue:[
- requestor requirePackages:list
- ].
- ] ifFalse:[
- Transcript showCR:'unrecognized ''prerequisites'' directive'.
- ^ false
- ]
+ self parsePrerequisitesDirective.
].
"
Syntax: 'name-of-dialect'
"
directive = 'syntax' ifTrue:[
- syntax := self parseDirectiveStringArg.
- syntax notNil ifTrue:[
- (requestor notNil
- and:[requestor respondsTo:#setSyntax:]) ifTrue:[
- requestor setSyntax:namespace
- ] ifFalse:[
- self setSyntax:syntax
- ].
- ] ifFalse:[
- Transcript showCR:'unrecognized ''syntax'' directive'.
- ^ false
- ].
+ self parseSyntaxDirective.
+ ].
+
+ "
+ Class: className
+ "
+ directive = 'class' ifTrue:[
+ self parseClassDirective.
+ ].
+ "
+ ClassHint: className
+ "
+ directive = 'classhint' ifTrue:[
+ self parseClassHintDirective.
].
]
].
@@ -908,20 +923,41 @@
"Modified: / 5.3.1998 / 02:55:32 / cg"
!
+parseDirectiveClassNameArg
+ "helper for parsing a directive"
+
+ ^ self parseDirectiveStringArg:[:ch | ch isLetter or:[ch == $_ or:[ch == $:]]].
+!
+
parseDirectiveStringArg
"helper for parsing a directive"
+ ^ self parseDirectiveStringArg:[:ch | ch isLetter or:[ch == $_]]
+!
+
+parseDirectiveStringArg:characterCheckBlock
+ "helper for parsing a directive"
+
+ |strBuffer|
+
+ strBuffer := WriteStream on:(String new).
+
hereChar == $' ifTrue:[
- self nextString.
- tokenType == #String ifTrue:[
- ^ tokenValue
- ]
+ hereChar := source nextPeek.
+ [hereChar ~~ $'] whileTrue:[
+ strBuffer nextPut:hereChar.
+ hereChar := source nextPeek.
+ ].
+ hereChar := source nextPeek.
+ ^ strBuffer contents
].
- (hereChar isLetter or:[hereChar == $_]) ifTrue:[
- self nextIdentifier.
- tokenType == #Identifier ifTrue:[
- ^ tokenName
- ]
+
+ (characterCheckBlock value:hereChar) ifTrue:[
+ [characterCheckBlock value:hereChar] whileTrue:[
+ strBuffer nextPut:hereChar.
+ hereChar := source nextPeek.
+ ].
+ ^ strBuffer contents
].
^ nil
@@ -949,6 +985,97 @@
^ list
"Modified: / 5.3.1998 / 02:55:40 / cg"
+!
+
+parseNamespaceDirective
+ "
+ Namespace: 'nameSpace'
+ Namespace: nameSpace
+ "
+
+ |namespace target|
+
+ namespace := self parseDirectiveStringArg.
+ namespace isNil ifTrue:[
+ Transcript showCR:'unrecognized ''Namespace'' directive'.
+ ^ false
+ ].
+ target := (requestor notNil and:[ requestor respondsTo:#setNameSpace: ]) ifTrue:requestor ifFalse:self.
+ target setNameSpace:namespace.
+ ^ true
+!
+
+parsePackageDirective
+ "
+ Package: 'name-of-package'
+ Package: packageId
+ "
+
+ |packageName target|
+
+ packageName := self parseDirectiveStringArg.
+ packageName isNil ifTrue:[
+ Transcript showCR:'unrecognized ''Package'' directive'.
+ ^ false
+ ].
+ packageName := packageName asSymbol.
+ target := (requestor notNil and:[ requestor respondsTo:#setPackage: ]) ifTrue:requestor ifFalse:self.
+ target setPackage:packageName.
+ ^ true
+!
+
+parsePrerequisitesDirective
+ "
+ Prerequisites: 'name-of-package1', ... , 'name-of-packageN'
+ "
+
+ |list|
+
+ list := self parseDirectiveStringListArg.
+ list isNil ifTrue:[
+ Transcript showCR:'unrecognized ''Prerequisites'' directive'.
+ ^ false
+ ].
+ (requestor notNil and:[requestor respondsTo:#requirePackages:]) ifTrue:[
+ requestor requirePackages:list
+ ].
+ ^ true
+!
+
+parseSyntaxDirective
+ "
+ Syntax: 'st-syntax-id'
+ "
+
+ |syntax target|
+
+ syntax := self parseDirectiveStringArg.
+ syntax isNil ifTrue:[
+ Transcript showCR:'unrecognized ''Syntax'' directive'.
+ ^ false
+ ].
+ target := (requestor notNil and:[ requestor respondsTo:#setSyntax: ]) ifTrue:requestor ifFalse:self.
+ target setSyntax:syntax.
+ ^ true
+!
+
+parseUsesDirective
+ "
+ Uses: 'nameSpace1', ... , 'nameSpaceN'
+ Uses: nameSpaceId1, ... , nameSpaceIdN
+ "
+
+ |list|
+
+ list := self parseDirectiveStringListArg.
+ list isNil ifTrue:[
+ Transcript showCR:'unrecognized ''Uses'' directive'.
+ ^ false
+ ].
+ (requestor notNil and:[requestor respondsTo:#addNameSpaces:]) ifTrue:[
+ requestor addNameSpaces:list
+ ].
+ ^ true
! !
!Scanner methodsFor:'dummy-syntax highlighting'!
@@ -1549,8 +1676,7 @@
|comment|
saveComments ifTrue:[
- comment := Comment new.
- comment commentString:commentString; commentType:commentType.
+ comment := Comment new commentString:commentString commentType:commentType.
currentComments isNil ifTrue:[
currentComments := OrderedCollection with:comment
@@ -2261,7 +2387,9 @@
tokenValue := token := value.
tokenType := type.
- (tokenValue isLimitedPrecisionReal) ~~ (tokenType == #Float) ifTrue:[self halt].
+ (tokenValue isLimitedPrecisionReal) ~~ (tokenType == #Float) ifTrue:[
+ self halt:'unfinished feature'
+ ].
"/ self markConstantFrom:tokenPosition to:(source position - 1).
^ tokenType
@@ -2740,6 +2868,13 @@
"Created: / 17.2.1998 / 14:44:33 / cg"
!
+commentString:commentStringArg commentType:commentTypeArg
+ commentString := commentStringArg.
+ commentType := commentTypeArg.
+
+ "Created: / 17.2.1998 / 14:44:33 / cg"
+!
+
commentType
"return the value of the instance variable 'commentType' (automatically generated)"
@@ -2772,6 +2907,26 @@
^ commentString asStringCollection.
! !
+!Scanner::Directive class methodsFor:'instance creation'!
+
+newClassDirective
+ ^ ClassDirective new
+!
+
+newClassHintDirective
+ ^ ClassHintDirective new
+! !
+
+!Scanner::Directive::ClassDirective methodsFor:'accessing'!
+
+className
+ ^ className
+!
+
+className:something
+ className := something.
+! !
+
!Scanner::DoNotShowCompilerWarningAgainActionQuery class methodsFor:'queries'!
actionQuery
@@ -2781,7 +2936,7 @@
!Scanner class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.199 2005-05-09 07:25:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.200 2005-06-15 10:42:23 cg Exp $'
! !
Scanner initialize!