655 "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type" |
655 "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type" |
656 |
656 |
657 |cls selector protoSpec| |
657 |cls selector protoSpec| |
658 |
658 |
659 className isNil ifTrue:[ |
659 className isNil ifTrue:[ |
660 self warn:'No class defined !!'. |
660 self warn:'No class defined !!'. |
661 ^ self |
661 ^ self |
662 ]. |
662 ]. |
663 |
663 |
664 cls := self resolveName:className. |
664 cls := self resolveName:className. |
665 |
665 |
666 treeView propertiesDo:[:aProp| |
666 treeView propertiesDo:[:aProp| |
667 |selector| |
667 |selector| |
668 |
668 |
669 (selector := aProp model) notNil ifTrue:[ |
669 (selector := aProp model) notNil ifTrue:[ |
670 selector isArray ifFalse:[ |
670 selector isArray ifFalse:[ |
671 aTwoArgBlock value:(selector asSymbol) value:#modelAspect |
671 aTwoArgBlock value:(selector asSymbol) value:#modelAspect |
672 ]. |
672 ]. |
673 ]. |
673 ]. |
674 |
674 |
675 (selector := aProp menu) notNil ifTrue:[ |
675 (selector := aProp menu) notNil ifTrue:[ |
676 selector isArray ifFalse:[ |
676 selector isArray ifFalse:[ |
677 aTwoArgBlock value:(selector asSymbol) value:#menu |
677 aTwoArgBlock value:(selector asSymbol) value:#menu |
678 ]. |
678 ]. |
679 ]. |
679 ]. |
680 |
680 |
681 (aProp spec aspectSelectors) do:[:aSel | |
681 (aProp spec aspectSelectors) do:[:aSel | |
682 aSel isArray ifFalse:[ |
682 (aSel isArray or:[aSel isBoolean]) ifFalse:[ |
683 aTwoArgBlock value:(aSel asSymbol) value:#channelAspect |
683 aTwoArgBlock value:(aSel asSymbol) value:#channelAspect |
684 ]. |
684 ]. |
685 ]. |
685 ]. |
686 aProp spec actionSelectors do:[:aSel| |
686 aProp spec actionSelectors do:[:aSel| |
687 aSel isArray ifFalse:[ |
687 (aSel isArray or:[aSel isBoolean]) ifFalse:[ |
688 aTwoArgBlock value:(aSel asSymbol) value:#actionSelector |
688 aTwoArgBlock value:(aSel asSymbol) value:#actionSelector |
689 ]. |
689 ]. |
690 ]. |
690 ]. |
691 aProp spec valueSelectors do:[:aSel| |
691 aProp spec valueSelectors do:[:aSel| |
692 aSel isArray ifFalse:[ |
692 (aSel isArray or:[aSel isBoolean]) ifFalse:[ |
693 aTwoArgBlock value:(aSel asSymbol) value:#valueSelector |
693 aTwoArgBlock value:(aSel asSymbol) value:#valueSelector |
694 ]. |
694 ]. |
695 ] |
695 ] |
696 ]. |
696 ]. |
697 |
697 |
698 protoSpec := treeView canvasSpec. |
698 protoSpec := treeView canvasSpec. |
699 |
699 |
700 (selector := protoSpec menu) notNil ifTrue:[ |
700 (selector := protoSpec menu) notNil ifTrue:[ |
701 selector isArray ifFalse:[ |
701 selector isArray ifFalse:[ |
702 aTwoArgBlock value:(selector asSymbol) value:#menu |
702 aTwoArgBlock value:(selector asSymbol) value:#menu |
703 ]. |
703 ]. |
704 ]. |
704 ]. |
705 ! |
705 ! |
706 |
706 |
707 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
707 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
708 |selector args showIt code alreadyInSuperclass numArgs method| |
708 |selector args showIt code alreadyInSuperclass numArgs method| |
1062 ! |
1062 ! |
1063 |
1063 |
1064 generateCodeFrom:aListOfSelectors in:aClass do:aBlock |
1064 generateCodeFrom:aListOfSelectors in:aClass do:aBlock |
1065 |realSelectors redefCondition redefMessage| |
1065 |realSelectors redefCondition redefMessage| |
1066 |
1066 |
1067 realSelectors := aListOfSelectors select:[:sel | sel isArray not]. |
1067 realSelectors := aListOfSelectors reject:[:sel | sel isArray or:[sel isBoolean]]. |
1068 |
1068 |
1069 self class redefineAspectMethods ifTrue:[ |
1069 self class redefineAspectMethods ifTrue:[ |
1070 redefCondition := [:cls :sel | (cls includesSelector:sel) not]. |
1070 redefCondition := [:cls :sel | (cls includesSelector:sel) not]. |
1071 redefMessage := ' skipped - already implemented in the class'. |
1071 redefMessage := ' skipped - already implemented in the class'. |
1072 ] ifFalse:[ |
1072 ] ifFalse:[ |
1073 redefCondition := [:cls :sel | (cls canUnderstand:sel) not]. |
1073 redefCondition := [:cls :sel | (cls canUnderstand:sel) not]. |
1074 redefMessage := ' skipped - already implemented in the class (or superclass)'. |
1074 redefMessage := ' skipped - already implemented in the class (or superclass)'. |
1075 ]. |
1075 ]. |
1076 |
1076 |
1077 realSelectors do:[:aSelector| |
1077 realSelectors do:[:aSelector| |
1078 (redefCondition value:aClass value:aSelector) ifTrue:[ |
1078 (redefCondition value:aClass value:aSelector) ifTrue:[ |
1079 aBlock value:aSelector asSymbol |
1079 aBlock value:aSelector asSymbol |
1080 ] ifFalse:[ |
1080 ] ifFalse:[ |
1081 Transcript showCR:('#' , aSelector , redefMessage) |
1081 Transcript showCR:('#' , aSelector , redefMessage) |
1082 ] |
1082 ] |
1083 ] |
1083 ] |
1084 ! |
1084 ! |
1085 |
1085 |
1086 generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass |
1086 generateHookMethodFor:selectorSpec comment:commentWhen note:noteOrNil defaultCode:defaultCode inClass:targetClass |
1087 ^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' , |
1087 ^ ('!!' , targetClass name , ' methodsFor:''hooks''!!\\' , |