--- a/NewSystemBrowser.st Fri Feb 22 11:18:49 2002 +0100
+++ b/NewSystemBrowser.st Fri Feb 22 11:20:30 2002 +0100
@@ -28,7 +28,7 @@
ShowMethodTemplateWhenProtocolIsSelected
DefaultShowMethodTemplate DefaultEmphasizeUnloadedClasses
DefaultImmediateSyntaxColoring DefaultSyntaxColoring
- DefaultToolBarVisible DefaultCodeInfoVisible'
+ DefaultToolBarVisible DefaultCodeInfoVisible LastVisitorClassName'
poolDictionaries:''
category:'Interface-Browsers'
!
@@ -5203,13 +5203,20 @@
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
- #label: 'Visitor Pattern Support'
+ #label: 'Visitor Method'
#translateLabel: true
#value: #classMenuGenerateAcceptVisitor
#enabled: #hasClassSelectedHolder
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
+ #label: 'Visitor && Visited Methods'
+ #translateLabel: true
+ #value: #classMenuGenerateVisitorMethods
+ #enabled: #hasClassSelectedHolder
+ #isVisible: #hasNonMetaSelectedHolder
+ )
+ #(#MenuItem
#label: '-'
)
#(#MenuItem
@@ -14579,6 +14586,34 @@
"Modified: / 11.10.2001 / 22:19:09 / cg"
!
+classMenuGenerateVisitorMethods
+ "create visitor and visited methods"
+
+ |visitorClassName visitorClass|
+
+ visitorClassName := Dialog
+ request:'Name of Visitor class'
+ initialAnswer:(LastVisitorClassName ? '')
+ okLabel:(resources string:'Create')
+ title:'Visitor class'
+ onCancel:nil
+ list:#()
+ entryCompletionBlock:(self classNameEntryCompletionBlock).
+
+ visitorClass := self classIfValidNonMetaClassName:visitorClassName.
+ visitorClass isNil ifTrue:[^ nil].
+
+ LastVisitorClassName := visitorClassName.
+
+ self selectedClassesWithWaitCursorDo:[:eachClass |
+ self
+ createVisitorMethodsIn:eachClass theNonMetaclass andVisitorClass:visitorClass
+ ]
+
+ "Modified: / 11.10.2001 / 22:19:09 / cg"
+ "Created: / 11.10.2001 / 22:26:08 / cg"
+!
+
classMenuHierarchy
"show a classes hierarchy"
@@ -20654,7 +20689,8 @@
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
- list:list.
+ list:list
+ entryCompletionBlock:(self classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ self].
(newClassName startsWith:'---- ') ifTrue:[^ self].
@@ -21329,16 +21365,17 @@
].
].
- box entryCompletionBlock:[:contents |
- |s what m|
-
- s := contents withoutSpaces.
- what := Smalltalk classnameCompletion:s.
- box contents:what first.
- (what at:2) size ~~ 1 ifTrue:[
- self builder window beep
- ]
- ].
+ box entryCompletionBlock:(self classNameEntryCompletionBlock).
+"/ [:contents |
+"/ |s what m|
+"/
+"/ s := contents withoutSpaces.
+"/ what := Smalltalk classnameCompletion:s.
+"/ box contents:what first.
+"/ (what at:2) size ~~ 1 ifTrue:[
+"/ self builder window beep
+"/ ]
+"/ ].
box action:[:aString | className := aString].
box open.
@@ -21680,13 +21717,14 @@
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
- list:list.
+ list:list
+ entryCompletionBlock:(self classNameEntryCompletionBlock).
+
newClassName isNil ifTrue:[^ nil].
(newClassName startsWith:'---- ') ifTrue:[^ nil].
- newClass := Smalltalk classNamed:newClassName.
+ newClass := self classIfValidNonMetaClassName:newClassName.
newClass isNil ifTrue:[
- self warn:'no such class: ', newClassName.
^ nil
].
@@ -26247,7 +26285,7 @@
RefactoryChangeManager instance performChange:change.
!
-createAcceptVisitorMethodIn:aClass
+createAcceptVisitorMethod:selector in:aClass
"create an acceptVisitor: method
(I'm tired of typing)"
@@ -26262,8 +26300,8 @@
"stub code automatically generated - please change if required"
- ^ aVisitor accept%1:self
-') bindWith:aClass name)
+ ^ aVisitor %1self
+') bindWith:selector)
forClass:aClass
inCategory:'visiting'.
]
@@ -26271,6 +26309,15 @@
"Created: / 11.10.2001 / 22:29:35 / cg"
!
+createAcceptVisitorMethodIn:aClass
+ "create an acceptVisitor: method
+ (I'm tired of typing)"
+
+ self
+ createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
+ in:aClass
+!
+
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly
"workhorse for creating access methods for instvars."
@@ -27042,6 +27089,60 @@
forClass:aClass
inCategory:'documentation'.
]
+!
+
+createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
+ "create acceptVisitor: in visitedClass and acceptXXX in visitorClass.
+ (I'm tired of typing)"
+
+ |sel|
+
+ visitedClass isMeta ifTrue:[self halt].
+ visitorClass isMeta ifTrue:[self halt].
+
+ sel := ('visit' , visitedClass nameWithoutPrefix , ':').
+ self createAcceptVisitorMethod:sel in:visitedClass.
+
+ (visitorClass includesSelector:sel) ifFalse:[
+ self
+ compile:
+(('%1anObject
+ "dispatched back from the visited %2-object (visitor pattern)"
+
+ "fall back to general object-case - please change as required"
+
+ ^ self visitObject:anObject
+') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
+ forClass:visitorClass
+ inCategory:'visiting'.
+ ].
+
+ (visitorClass includesSelector:#'visitObject:') ifFalse:[
+ self
+ compile:
+('visitObject:anObject
+ "dispatched back from the visited objects (visitor pattern)"
+
+ "general fallBack - please change as required"
+
+ self halt:''not yet implemented''
+')
+ forClass:visitorClass
+ inCategory:'visiting'.
+ ].
+
+ (visitorClass includesSelector:#'visit:') ifFalse:[
+ self
+ compile:
+('visit:anObject
+ "visit anObject (visitor pattern).
+ The object should call back one of my visitXXXX methods."
+
+ ^ anObject acceptVisitor:self
+')
+ forClass:visitorClass
+ inCategory:'visiting'.
+ ]
! !
!NewSystemBrowser methodsFor:'private-code update'!
@@ -28926,6 +29027,59 @@
^ nil
!
+classIfValidNonMetaClassName:aClassName
+ |class|
+
+ aClassName isNil ifTrue:[^ nil].
+ class := Smalltalk classNamed:aClassName.
+
+ class isNil ifTrue:[
+ self warn:'No such class: ', aClassName.
+ ^ nil
+ ].
+ class isBehavior ifFalse:[
+ self warn:'Not a class: ', aClassName.
+ ^ nil
+ ].
+ (class isNameSpace
+ and:[class ~~ Smalltalk]) ifTrue:[
+ self warn:'Is a nameSpace: ', aClassName.
+ ^ nil
+ ].
+ (class theNonMetaclass isNameSpace
+ and:[class theNonMetaclass ~~ Smalltalk]) ifTrue:[
+ self warn:'Is meta of a nameSpace: ', aClassName.
+ ^ nil
+ ].
+ ^ class
+!
+
+classNameEntryCompletionBlock
+ ^ [:contents :field |
+ |s what m|
+
+ s := contents withoutSpaces.
+ what := Smalltalk classnameCompletion:s.
+ field contents:what first.
+ (what at:2) size ~~ 1 ifTrue:[
+ field device beep
+ ]
+ ].
+!
+
+classNameEntryCompletionBlockFor:anEntryField
+ ^ [:contents |
+ |s what m|
+
+ s := contents withoutSpaces.
+ what := Smalltalk classnameCompletion:s.
+ anEntryField contents:what first.
+ (what at:2) size ~~ 1 ifTrue:[
+ self builder window beep
+ ]
+ ].
+!
+
classes:aCollectionOfClasses nonMetaDo:aBlock ifUnloaded:unloadedBlock ifPrivate:privateBlock
"evaluate aBlock for all selected classes;
pass the non-metaclass as arg"
@@ -51636,6 +51790,6 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.312 2002-02-21 10:02:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.313 2002-02-22 10:20:30 cg Exp $'
! !
NewSystemBrowser initialize!
--- a/Tools__NewSystemBrowser.st Fri Feb 22 11:18:49 2002 +0100
+++ b/Tools__NewSystemBrowser.st Fri Feb 22 11:20:30 2002 +0100
@@ -28,7 +28,7 @@
ShowMethodTemplateWhenProtocolIsSelected
DefaultShowMethodTemplate DefaultEmphasizeUnloadedClasses
DefaultImmediateSyntaxColoring DefaultSyntaxColoring
- DefaultToolBarVisible DefaultCodeInfoVisible'
+ DefaultToolBarVisible DefaultCodeInfoVisible LastVisitorClassName'
poolDictionaries:''
category:'Interface-Browsers'
!
@@ -5203,13 +5203,20 @@
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
- #label: 'Visitor Pattern Support'
+ #label: 'Visitor Method'
#translateLabel: true
#value: #classMenuGenerateAcceptVisitor
#enabled: #hasClassSelectedHolder
#isVisible: #hasNonMetaSelectedHolder
)
#(#MenuItem
+ #label: 'Visitor && Visited Methods'
+ #translateLabel: true
+ #value: #classMenuGenerateVisitorMethods
+ #enabled: #hasClassSelectedHolder
+ #isVisible: #hasNonMetaSelectedHolder
+ )
+ #(#MenuItem
#label: '-'
)
#(#MenuItem
@@ -14579,6 +14586,34 @@
"Modified: / 11.10.2001 / 22:19:09 / cg"
!
+classMenuGenerateVisitorMethods
+ "create visitor and visited methods"
+
+ |visitorClassName visitorClass|
+
+ visitorClassName := Dialog
+ request:'Name of Visitor class'
+ initialAnswer:(LastVisitorClassName ? '')
+ okLabel:(resources string:'Create')
+ title:'Visitor class'
+ onCancel:nil
+ list:#()
+ entryCompletionBlock:(self classNameEntryCompletionBlock).
+
+ visitorClass := self classIfValidNonMetaClassName:visitorClassName.
+ visitorClass isNil ifTrue:[^ nil].
+
+ LastVisitorClassName := visitorClassName.
+
+ self selectedClassesWithWaitCursorDo:[:eachClass |
+ self
+ createVisitorMethodsIn:eachClass theNonMetaclass andVisitorClass:visitorClass
+ ]
+
+ "Modified: / 11.10.2001 / 22:19:09 / cg"
+ "Created: / 11.10.2001 / 22:26:08 / cg"
+!
+
classMenuHierarchy
"show a classes hierarchy"
@@ -20654,7 +20689,8 @@
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
- list:list.
+ list:list
+ entryCompletionBlock:(self classNameEntryCompletionBlock).
newClassName isNil ifTrue:[^ self].
(newClassName startsWith:'---- ') ifTrue:[^ self].
@@ -21329,16 +21365,17 @@
].
].
- box entryCompletionBlock:[:contents |
- |s what m|
-
- s := contents withoutSpaces.
- what := Smalltalk classnameCompletion:s.
- box contents:what first.
- (what at:2) size ~~ 1 ifTrue:[
- self builder window beep
- ]
- ].
+ box entryCompletionBlock:(self classNameEntryCompletionBlock).
+"/ [:contents |
+"/ |s what m|
+"/
+"/ s := contents withoutSpaces.
+"/ what := Smalltalk classnameCompletion:s.
+"/ box contents:what first.
+"/ (what at:2) size ~~ 1 ifTrue:[
+"/ self builder window beep
+"/ ]
+"/ ].
box action:[:aString | className := aString].
box open.
@@ -21680,13 +21717,14 @@
okLabel:(resources string:okLabel)
title:(resources string:title)
onCancel:nil
- list:list.
+ list:list
+ entryCompletionBlock:(self classNameEntryCompletionBlock).
+
newClassName isNil ifTrue:[^ nil].
(newClassName startsWith:'---- ') ifTrue:[^ nil].
- newClass := Smalltalk classNamed:newClassName.
+ newClass := self classIfValidNonMetaClassName:newClassName.
newClass isNil ifTrue:[
- self warn:'no such class: ', newClassName.
^ nil
].
@@ -26247,7 +26285,7 @@
RefactoryChangeManager instance performChange:change.
!
-createAcceptVisitorMethodIn:aClass
+createAcceptVisitorMethod:selector in:aClass
"create an acceptVisitor: method
(I'm tired of typing)"
@@ -26262,8 +26300,8 @@
"stub code automatically generated - please change if required"
- ^ aVisitor accept%1:self
-') bindWith:aClass name)
+ ^ aVisitor %1self
+') bindWith:selector)
forClass:aClass
inCategory:'visiting'.
]
@@ -26271,6 +26309,15 @@
"Created: / 11.10.2001 / 22:29:35 / cg"
!
+createAcceptVisitorMethodIn:aClass
+ "create an acceptVisitor: method
+ (I'm tired of typing)"
+
+ self
+ createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
+ in:aClass
+!
+
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly
"workhorse for creating access methods for instvars."
@@ -27042,6 +27089,60 @@
forClass:aClass
inCategory:'documentation'.
]
+!
+
+createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
+ "create acceptVisitor: in visitedClass and acceptXXX in visitorClass.
+ (I'm tired of typing)"
+
+ |sel|
+
+ visitedClass isMeta ifTrue:[self halt].
+ visitorClass isMeta ifTrue:[self halt].
+
+ sel := ('visit' , visitedClass nameWithoutPrefix , ':').
+ self createAcceptVisitorMethod:sel in:visitedClass.
+
+ (visitorClass includesSelector:sel) ifFalse:[
+ self
+ compile:
+(('%1anObject
+ "dispatched back from the visited %2-object (visitor pattern)"
+
+ "fall back to general object-case - please change as required"
+
+ ^ self visitObject:anObject
+') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
+ forClass:visitorClass
+ inCategory:'visiting'.
+ ].
+
+ (visitorClass includesSelector:#'visitObject:') ifFalse:[
+ self
+ compile:
+('visitObject:anObject
+ "dispatched back from the visited objects (visitor pattern)"
+
+ "general fallBack - please change as required"
+
+ self halt:''not yet implemented''
+')
+ forClass:visitorClass
+ inCategory:'visiting'.
+ ].
+
+ (visitorClass includesSelector:#'visit:') ifFalse:[
+ self
+ compile:
+('visit:anObject
+ "visit anObject (visitor pattern).
+ The object should call back one of my visitXXXX methods."
+
+ ^ anObject acceptVisitor:self
+')
+ forClass:visitorClass
+ inCategory:'visiting'.
+ ]
! !
!NewSystemBrowser methodsFor:'private-code update'!
@@ -28926,6 +29027,59 @@
^ nil
!
+classIfValidNonMetaClassName:aClassName
+ |class|
+
+ aClassName isNil ifTrue:[^ nil].
+ class := Smalltalk classNamed:aClassName.
+
+ class isNil ifTrue:[
+ self warn:'No such class: ', aClassName.
+ ^ nil
+ ].
+ class isBehavior ifFalse:[
+ self warn:'Not a class: ', aClassName.
+ ^ nil
+ ].
+ (class isNameSpace
+ and:[class ~~ Smalltalk]) ifTrue:[
+ self warn:'Is a nameSpace: ', aClassName.
+ ^ nil
+ ].
+ (class theNonMetaclass isNameSpace
+ and:[class theNonMetaclass ~~ Smalltalk]) ifTrue:[
+ self warn:'Is meta of a nameSpace: ', aClassName.
+ ^ nil
+ ].
+ ^ class
+!
+
+classNameEntryCompletionBlock
+ ^ [:contents :field |
+ |s what m|
+
+ s := contents withoutSpaces.
+ what := Smalltalk classnameCompletion:s.
+ field contents:what first.
+ (what at:2) size ~~ 1 ifTrue:[
+ field device beep
+ ]
+ ].
+!
+
+classNameEntryCompletionBlockFor:anEntryField
+ ^ [:contents |
+ |s what m|
+
+ s := contents withoutSpaces.
+ what := Smalltalk classnameCompletion:s.
+ anEntryField contents:what first.
+ (what at:2) size ~~ 1 ifTrue:[
+ self builder window beep
+ ]
+ ].
+!
+
classes:aCollectionOfClasses nonMetaDo:aBlock ifUnloaded:unloadedBlock ifPrivate:privateBlock
"evaluate aBlock for all selected classes;
pass the non-metaclass as arg"
@@ -51636,6 +51790,6 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.312 2002-02-21 10:02:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.313 2002-02-22 10:20:30 cg Exp $'
! !
NewSystemBrowser initialize!