Mercurial Mercurial > hg > stx-libbasic / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Annotation.st
branchjv
changeset 17993 956342c369a2
parent 17976 50c2416f962a
child 18011 deb0c3355881 
--- a/Annotation.st	Wed Nov 28 10:22:05 2012 +0000
+++ b/Annotation.st	Fri Nov 30 17:19:23 2012 +0000
@@ -12,28 +12,28 @@
 "{ Package: 'stx:libbasic' }"
 
 Object subclass:#Annotation
-	instanceVariableNames:''
+	instanceVariableNames:'key arguments'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Extensions'
 !
 
 Annotation subclass:#NameSpace
-	instanceVariableNames:'nameSpace'
+	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:Annotation
 !
 
 Annotation subclass:#Resource
-	instanceVariableNames:'type value'
+	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:Annotation
 !
 
 Annotation subclass:#Unknown
-	instanceVariableNames:'method key arguments'
+	instanceVariableNames:'method'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:Annotation
@@ -118,7 +118,7 @@
 
     ^
     "/ cg: do not react on all those methods inherited from Object (such as inline:)
-    "/ self respondsTo: key)
+    "/ (self respondsTo: key)
     (self class includesSelector:key) 
         ifTrue:
             [self 
@@ -146,14 +146,14 @@
 namespace: aString
     <resource: #obsolete>
 
-    ^Annotation::NameSpace new nameSpaceName: aString
+    ^ self nameSpace:aString
 
     "Created: / 19-05-2010 / 16:01:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 resource: type
 
-    ^Annotation::Resource new type: type
+    ^Annotation::Resource new type: type value:nil
 
     "Created: / 16-07-2010 / 11:31:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
@@ -161,12 +161,13 @@
 resource: type value: value
 
     ^Annotation::Resource new 
-        type: type;
-        value: value
+        type: type value: value
 
     "Created: / 16-07-2010 / 11:31:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+
+
 !Annotation class methodsFor:'finding'!
 
 allNamed: aSymbol from: aSubClass to: aSuperClass
@@ -229,8 +230,13 @@
     "Modified: / 20-08-2011 / 21:31:49 / cg"
 ! !
 
+
 !Annotation methodsFor:'accessing'!
 
+arguments
+    ^ arguments
+!
+
 first
 
     ^self key
@@ -239,11 +245,7 @@
 !
 
 key
-
-    ^self subclassResponsibility
-
-    "Created: / 19-05-2010 / 16:23:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 16-07-2010 / 11:29:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    ^ key
 ! !
 
 !Annotation methodsFor:'accessing-method'!
@@ -281,14 +283,6 @@
 	^ self arguments at: anInteger.
 !
 
-arguments
-        "Answer the arguments of the receiving pragma. For a pragma defined as <key1: val1 key2: val2> this will answer #(val1 val2)."
-
-    self subclassResponsibility
-
-    "Modified: / 21-08-2011 / 12:43:54 / cg"
-!
-
 message
 	"Answer the message of the receiving pragma."
 	
@@ -321,14 +315,19 @@
 
 !Annotation methodsFor:'initialization'!
 
+key:keyArg arguments:argumentsArg 
+    key := keyArg.
+    arguments := argumentsArg.
+!
+
 setArguments: anArray
-    self subclassResponsibility
+    arguments := anArray
 
     "Modified: / 21-08-2011 / 12:45:51 / cg"
 !
 
 setKeyword: aSymbol
-        self subclassResponsibility
+    key := aSymbol
 
     "Modified: / 21-08-2011 / 12:46:06 / cg"
 !
@@ -352,10 +351,15 @@
 !Annotation methodsFor:'printing & storing'!
 
 storeOn:aStream
+    "superclass Annotation says that I am responsible to implement this method"
 
-    self subclassResponsibility
+    aStream nextPutAll: '(Annotation key: '.
+    key storeOn: aStream.
+    aStream nextPutAll: ' arguments: '.
+    arguments storeOn: aStream.
+    aStream nextPut: $).
 
-    "Created: / 19-05-2010 / 16:26:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 19-05-2010 / 16:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !Annotation methodsFor:'processing'!
@@ -389,10 +393,21 @@
 !Annotation methodsFor:'queries'!
 
 refersToLiteral: anObject
-    (anObject == self key) ifTrue:[ ^ true ].
+    (anObject == key) ifTrue:[ ^ true ].
+    (anObject == arguments) ifTrue:[ ^ true ].
+    arguments isArray ifTrue:[ ^ arguments refersToLiteral: anObject].
     ^ false
 
-    "Created: / 26-07-2012 / 15:58:34 / cg"
+    "Created: / 26-07-2012 / 15:57:43 / cg"
+!
+
+refersToLiteralMatching: aMatchString
+    (key isSymbol and:[aMatchString match:key])ifTrue:[ ^ true ].
+    (arguments isSymbol and:[aMatchString match:arguments])ifTrue:[ ^ true ].
+    arguments isArray ifTrue:[ ^ arguments refersToLiteralMatching: aMatchString].
+    ^ false
+
+    "Created: / 26-07-2012 / 16:00:58 / cg"
 ! !
 
 !Annotation methodsFor:'testing'!
@@ -433,11 +448,11 @@
 !
 
 nameSpace
-    ^ nameSpace
+    ^ arguments first
 !
 
 nameSpace:something
-    nameSpace := something.
+    arguments := Array with:something.
 ! !
 
 !Annotation::NameSpace methodsFor:'initialization'!
@@ -455,7 +470,7 @@
     "superclass Annotation says that I am responsible to implement this method"
 
     aStream nextPutAll: '(Annotation namespace: '.
-    nameSpace name storeOn: aStream.
+    self nameSpace name storeOn: aStream.
     aStream nextPut:$)
 
     "Modified: / 19-05-2010 / 16:27:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -479,40 +494,35 @@
 
 !Annotation::Resource methodsFor:'accessing'!
 
-key
-    "superclass Annotation says that I am responsible to implement this method"
-
-    ^value 
-        ifNil:[#resource:]
-        ifNotNil:[#resource:value:]
-
-    "Modified: / 16-07-2010 / 11:30:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+type
+    ^ arguments at:1
 !
 
-type
-    ^ type
-!
-
-type:something
-    type := something.
+type:typeArg value:valueArg
+    valueArg isNil ifTrue:[
+        key := #'resource:'.
+        arguments := Array with:typeArg.
+    ] ifFalse:[
+        key := #'resource:value:'.
+        arguments := Array with:typeArg with:valueArg.
+    ].
 !
 
 value
-    ^ value
-!
-
-value:something
-    value := something.
+    arguments size > 1 ifTrue:[
+        ^ arguments at:2
+    ].
+    ^ nil
 ! !
 
 !Annotation::Resource methodsFor:'printing & storing'!
 
 storeOn:aStream
     aStream nextPutAll: '(Annotation resource: '.
-    type storeOn: aStream.
-    value notNil ifTrue: [
+    self type storeOn: aStream.
+    self value notNil ifTrue: [
         aStream nextPutAll: ' value: '.
-        value storeOn: aStream
+        self value storeOn: aStream
     ].    
     aStream nextPut:$)
 
@@ -537,26 +547,6 @@
     "Modified: / 16-07-2010 / 11:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
-!Annotation::Resource methodsFor:'queries'!
-
-refersToLiteral: anObject
-    (anObject == type) ifTrue:[ ^ true ].
-    (anObject == value) ifTrue:[ ^ true ].
-    value isArray ifTrue:[ ^ value refersToLiteral: anObject].
-    ^ false
-
-    "Created: / 26-07-2012 / 15:57:58 / cg"
-!
-
-refersToLiteralMatching: aMatchString
-    (type isSymbol and:[aMatchString match:type])ifTrue:[ ^ true ].
-    (value isSymbol and:[aMatchString match:value])ifTrue:[ ^ true ].
-    value isArray ifTrue:[ ^ value refersToLiteralMatching: aMatchString].
-    ^ false
-
-    "Created: / 26-07-2012 / 16:01:26 / cg"
-! !
-
 !Annotation::Resource methodsFor:'testing'!
 
 isResource
@@ -567,27 +557,20 @@
 
 !Annotation::Unknown methodsFor:'accessing'!
 
-arguments
-    ^ arguments
+method
+    ^ method
+
+    "Created: / 05-09-2011 / 04:38:33 / cg"
 !
 
-key
-    ^ key
-!
-
-method
-    ^ method
+setMethod:aMethod
+    method := aMethod
 
     "Created: / 05-09-2011 / 04:38:33 / cg"
 ! !
 
 !Annotation::Unknown methodsFor:'initialization'!
 
-key:keyArg arguments:argumentsArg 
-    key := keyArg.
-    arguments := argumentsArg.
-!
-
 method:methodArg key:keyArg arguments:argumentsArg
     method := methodArg.
     key := keyArg.
@@ -596,20 +579,6 @@
     "Created: / 05-09-2011 / 04:39:50 / cg"
 ! !
 
-!Annotation::Unknown methodsFor:'printing & storing'!
-
-storeOn:aStream
-    "superclass Annotation says that I am responsible to implement this method"
-
-    aStream nextPutAll: '(Annotation key: '.
-    key storeOn: aStream.
-    aStream nextPutAll: ' arguments: '.
-    arguments storeOn: aStream.
-    aStream nextPut: $).
-
-    "Modified: / 19-05-2010 / 16:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
 !Annotation::Unknown methodsFor:'processing'!
 
 annotatesClass:aClass
@@ -630,20 +599,12 @@
 
 refersToLiteral: anObject
     (anObject == method) ifTrue:[ ^ true ].
-    (anObject == key) ifTrue:[ ^ true ].
-    (anObject == arguments) ifTrue:[ ^ true ].
-    arguments isArray ifTrue:[ ^ arguments refersToLiteral: anObject].
-    ^ false
-
-    "Created: / 26-07-2012 / 15:57:43 / cg"
+    ^ super refersToLiteral: anObject
 !
 
 refersToLiteralMatching: aMatchString
     (method isSymbol and:[aMatchString match:method])ifTrue:[ ^ true ].
-    (key isSymbol and:[aMatchString match:key])ifTrue:[ ^ true ].
-    (arguments isSymbol and:[aMatchString match:arguments])ifTrue:[ ^ true ].
-    arguments isArray ifTrue:[ ^ arguments refersToLiteralMatching: aMatchString].
-    ^ false
+    ^ super refersToLiteralMatching: aMatchString
 
     "Created: / 26-07-2012 / 16:00:58 / cg"
 ! !
@@ -657,15 +618,15 @@
 !Annotation class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.12 2012/10/29 10:25:12 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.14 2012/11/05 23:56:53 cg Exp $'
 !
 
 version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.12 2012/10/29 10:25:12 cg Exp §'
+    ^ '§Header: /cvs/stx/stx/libbasic/Annotation.st,v 1.14 2012/11/05 23:56:53 cg Exp §'
 !
 
 version_SVN
-    ^ '$Id: Annotation.st 10858 2012-10-29 22:07:56Z vranyj1 $'
+    ^ '$Id: Annotation.st 10876 2012-11-30 17:19:23Z vranyj1 $'
 ! !
 
 Annotation initialize!
hg/stx-libbasic