--- a/ClassChange.st Wed Feb 05 18:52:27 2014 +0100
+++ b/ClassChange.st Wed Feb 05 18:52:29 2014 +0100
@@ -12,7 +12,8 @@
"{ Package: 'stx:libbasic3' }"
Change subclass:#ClassChange
- instanceVariableNames:'className classIsJava package nameSpaceOverride'
+ instanceVariableNames:'className classIsJava package nameSpaceOverride nameSpaceName
+ owningClassName'
classVariableNames:''
poolDictionaries:''
category:'System-Changes'
@@ -41,6 +42,17 @@
[author:]
Claus Gittinger
+ Jan Vrany
+
+ [:instvars] incomplete
+ className <String> ............ the class name *without* namespace,
+ but including all owners (if the class
+ is private)
+ owningClassName <String|nil> .. class name of the owning class if any
+ nameSpaceName <String|nil> .... namespace name of the change or nil, if
+ class is in no namespace.
+ nameSpaceOverride <NameSpace|nil> enforced namespace in which the class will
+ should be installed.
"
! !
@@ -79,31 +91,35 @@
"do not autoload an owning class of a private class!!"
- |className class owner altName nsName ns meta|
+ |clsNm class owner altName nsName ns meta|
- className := self className.
- className isNil ifTrue:[^ nil].
+ clsNm := self className.
+ clsNm isNil ifTrue:[^ nil].
"/ ok, try some heuristics (for example Root.something -> Smalltalk::something)
- (className includes:$.) ifTrue:[
+ (clsNm includes:$.) ifTrue:[
"/ VW - namespace prefix - convert to colon-notation
- className := className copyReplaceAll:$. withAll:'::'.
+ clsNm := clsNm copyReplaceAll:$. withAll:'::'.
].
- nsName := self nameSpaceOverride ? 'Smalltalk'.
+ nsName := self nameSpaceName ? 'Smalltalk'.
+ (nsName includes:$.) ifTrue:[
+ "/ VW - namespace prefix - convert to colon-notation
+ nsName := nsName copyReplaceAll:$. withAll:'::'.
+ ].
nsName notNil ifTrue:[
ns := Smalltalk at:nsName asSymbol.
ns isNil ifTrue:[
- ns := NameSpace name:nsName
+ ns := NameSpace fullName:nsName
]
].
- (meta := (className endsWith:' class')) ifTrue:[
- className := className copyButLast:6.
+ (meta := (clsNm endsWith:' class')) ifTrue:[
+ clsNm := clsNm copyButLast:6.
].
ns := (ns ? Smalltalk).
class := ns isNameSpace
- ifTrue:[ ns loadedClassNamed:className ]
- ifFalse:[ Smalltalk loadedClassNamed:className ].
+ ifTrue:[ ns loadedClassNamed:clsNm ]
+ ifFalse:[ Smalltalk loadedClassNamed:clsNm ].
class isNil ifTrue:[
self isPrivateClassDefinitionChange ifTrue:[
ns isNameSpace ifTrue:[
@@ -112,17 +128,17 @@
owner := Smalltalk loadedClassNamed:(self owningClassName).
].
owner notNil ifTrue:[
- class := owner privateClassesAt:className.
+ class := owner privateClassesAt:clsNm.
^ meta ifTrue:[class theMetaclass] ifFalse:[class].
].
] ifFalse:[
class := ns isNameSpace
- ifTrue:[ ns classNamed:className ]
- ifFalse:[ Smalltalk loadedClassNamed:className ].
+ ifTrue:[ ns classNamed:clsNm ]
+ ifFalse:[ Smalltalk loadedClassNamed:clsNm ].
"/ class := Parser evaluate:className ifFail:[nil].
class isNil ifTrue:[
- (altName := self classNameForWellKnownVisualWorksNamespaceClass:className) notNil
+ (altName := self classNameForWellKnownVisualWorksNamespaceClass:clsNm) notNil
ifTrue:[
class := ns isNameSpace
ifTrue:[ ns classNamed:altName ]
@@ -138,11 +154,11 @@
self isPrivateClassDefinitionChange ifTrue:[
owner := Smalltalk loadedClassNamed:(self owningClassName).
owner notNil ifTrue:[
- class := owner privateClassesAt:className.
+ class := owner privateClassesAt:clsNm.
^ meta ifTrue:[class theMetaclass] ifFalse:[class].
].
] ifFalse:[
- class := Smalltalk classNamed:className.
+ class := Smalltalk classNamed:clsNm.
"/ class := Parser evaluate:className ifFail:[nil].
class isNil ifTrue:[
^ nil.
@@ -158,6 +174,7 @@
^ meta ifTrue:[class theMetaclass] ifFalse:[class].
"Modified: / 10-08-2012 / 12:07:26 / cg"
+ "Modified: / 12-12-2013 / 13:35:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changeClass:aClass
@@ -190,7 +207,11 @@
!
className
+ "Returns class name of the class *without* namespace, but with
+ all owning classes (if the change class is a private class)"
^ className
+
+ "Modified (comment): / 12-06-2013 / 11:33:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
className:aString
@@ -209,11 +230,12 @@
self assert:(newSource isString).
self assert:(newClassName isString).
- className := newClassName.
+ self className: newClassName.
source := newSource.
- "Created: 3.12.1995 / 14:01:45 / cg"
- "Modified: 15.7.1996 / 09:28:26 / cg"
+ "Created: / 03-12-1995 / 14:01:45 / cg"
+ "Modified: / 15-07-1996 / 09:28:26 / cg"
+ "Modified: / 11-06-2013 / 17:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classNameForWellKnownVisualWorksNamespaceClass:className
@@ -240,6 +262,10 @@
!
fullClassName
+ "Returns fully qualified class name, i.e., including namespace in which the
+ class should be installed (i.e., the override namespace (if any) rather than
+ original namespace (of any))"
+
|ns|
"/ used to be ^ className;
@@ -250,14 +276,19 @@
(ns isNil or:[ns = 'Smalltalk']) ifTrue:[^ self className].
^ ns , '::' , self className
+
+ "Modified (comment): / 04-02-2014 / 19:29:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
localClassName
"for private classes, this returns the name relative to its owner;
for non-private ones, this is the regular name.
- Notice that className always returns the full name (incl. any owner prefix)"
+ Notice that className always returns the full name (incl. any owner prefix)
+ but *without* any namespace prefix"
^self className
+
+ "Modified (comment): / 12-06-2013 / 11:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nameSpace
@@ -269,45 +300,79 @@
^ Smalltalk
!
+nameSpace: aNameSpace
+ self nameSpaceName: aNameSpace name
+
+ "Created: / 11-06-2013 / 15:57:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
nameSpaceName
- |ns cnm idx|
+ "Return the namespace in which the class should be installed.
+
+ If the user enforces a namespace using nameSpaceOverride or
+ using query signal, then the enforced namespace is returned.
+ Otherwise, changes's original namespace is returned, if any."
+
+ | ns |
className isNil ifTrue:[^ nil].
ns := self nameSpaceOverride.
ns notNil ifTrue:[ ^ ns ].
- (idx := className indexOf:$:) ~~ 0 ifTrue:[
- "/ in a namespace
- ^ className copyTo:(idx - 1).
- ].
- (idx := className indexOf:$.) ~~ 0 ifTrue:[
- "/ in a namespace
- ns := className copyTo:(idx - 1).
- cnm := className copyFrom:(idx + 1).
- "cheat: VW namespaces"
- ^ self nameSpaceForVWNamespace:ns class:cnm ifAbsent:ns
- ].
- ^ nil
+"/ JV: Following code is rubbish because it cannot distiguish
+"/ between namespace and owning class...
+
+"/ (idx := className indexOf:$:) ~~ 0 ifTrue:[
+"/ "/ in a namespace
+"/ ^ className copyTo:(idx - 1).
+"/ ].
+
+"/ JV: I commented following It is not clear to how it is supposed to
+"/ work. If anybody wants this back, he/she should first write
+"/ a testcase to demonstrate how it should work.
+
+"/ (idx := className indexOf:$.) ~~ 0 ifTrue:[
+"/ "/ in a namespace
+"/ ns := className copyTo:(idx - 1).
+"/ cnm := className copyFrom:(idx + 1).
+"/ "cheat: VW namespaces"
+"/ ^ self nameSpaceForVWNamespace:ns class:cnm ifAbsent:ns
+"/ ].
+
+ ^ nameSpaceName
"Modified: / 03-08-2006 / 02:04:03 / cg"
- "Modified: / 09-05-2013 / 13:33:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 11-06-2013 / 15:03:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 04-02-2014 / 17:54:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nameSpaceName: aString
+ nameSpaceName := aString ~= 'Smalltalk' ifTrue:[aString] ifFalse:[nil].
+
+ "Created: / 11-06-2013 / 15:53:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nameSpaceOverride
+ "Return namespace enforced by the caller.
+
+ NOTE: This code used to use `Class nameSpaceQuerySignal` to
+ allow enforcing namespace by query. This made the code more
+ complicated and was used only by Tools::ChangeSetBrowser2 so
+ it was removed.
+
+ To apply change in particular namespace, use nameSpaceOverride:.
+ You may use applyWithNameSpaceOverride: for your convenience.
+ "
+
|ns|
ns := nameSpaceOverride.
- Class nameSpaceQuerySignal isHandled ifTrue:[
- ns := Class nameSpaceQuerySignal query.
- ] ifFalse:[
- "/ self halt
- ].
ns isNil ifTrue:[^ nil].
- "/ ns == Smalltalk ifTrue:[^ nil].
^ ns name
"Created: / 07-09-2011 / 20:45:43 / cg"
+ "Modified (comment): / 04-02-2014 / 18:33:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
nameSpaceOverride:aNamespaceOrString
@@ -328,6 +393,18 @@
"Created: / 06-11-2008 / 17:26:03 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
+owningClassName
+ ^ owningClassName
+
+ "Modified: / 11-06-2013 / 14:50:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+owningClassName:aStringOrSymbol
+ owningClassName := aStringOrSymbol
+
+ "Created: / 30-08-2010 / 13:55:37 / cg"
+!
+
package
"return the value of the instance variable 'package' (automatically generated)"
@@ -367,6 +444,19 @@
"/ ].
"Modified: / 29-01-2011 / 12:28:03 / cg"
+!
+
+applyWithNameSpaceOverride: nameSpaceOrNameSpaceName
+ "Apply the change, overriding a namespace to given one"
+
+ | savedNameSpaceOverride |
+
+ savedNameSpaceOverride := nameSpaceOverride.
+ nameSpaceOverride := nameSpaceOrNameSpaceName.
+ self apply.
+ nameSpaceOverride := savedNameSpaceOverride
+
+ "Created: / 04-02-2014 / 18:24:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ClassChange methodsFor:'printing & storing'!
@@ -433,20 +523,16 @@
ns = 'Smalltalk' ifTrue:[^ 'Smalltalk'].
ns = 'UI' ifTrue:[^ 'Smalltalk'].
^ default value
-!
-
-owningClassName
- self shouldImplement
! !
!ClassChange class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.74 2013-05-09 12:49:14 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.75 2014-02-05 17:52:29 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.74 2013-05-09 12:49:14 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.75 2014-02-05 17:52:29 cg Exp $'
!
version_HG
@@ -455,6 +541,6 @@
!
version_SVN
- ^ '$Id: ClassChange.st,v 1.74 2013-05-09 12:49:14 vrany Exp $'
+ ^ '$Id: ClassChange.st,v 1.75 2014-02-05 17:52:29 cg Exp $'
! !