diff -r 69f4593db7d5 -r 482fb73aa844 Scanner.st
--- 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!