570 !UIPainterView methodsFor:'generating output'! |
570 !UIPainterView methodsFor:'generating output'! |
571 |
571 |
572 aspectMethods |
572 aspectMethods |
573 "extract a list of aspect methods - for browsing" |
573 "extract a list of aspect methods - for browsing" |
574 |
574 |
575 |cls methods skip selector protoSpec| |
575 |cls methods| |
576 |
576 |
577 className isNil ifTrue:[ |
577 className isNil ifTrue:[ |
578 self warn:'set the class first'. |
578 self warn:'No class defined !!'. |
579 ^ #() |
579 ^ #() |
580 ]. |
580 ]. |
581 |
581 |
582 cls := self resolveName:className. |
582 cls := self resolveName:className. |
583 methods := IdentitySet new. |
583 methods := IdentitySet new. |
584 |
584 |
|
585 self aspectSelectorsAndTypesDo: |
|
586 [:selector :typeSymbol | |
|
587 |skip| |
|
588 |
|
589 (cls includesSelector:selector) ifTrue:[ |
|
590 |
|
591 skip := false. |
|
592 (typeSymbol == #modelAspect) ifTrue:[ |
|
593 (cls isSubclassOf:SimpleDialog) ifTrue:[ |
|
594 skip := SimpleDialog includesSelector:(selector asSymbol) |
|
595 ]. |
|
596 ]. |
|
597 skip ifFalse:[ |
|
598 methods add:(cls compiledMethodAt:selector) |
|
599 ]. |
|
600 ] |
|
601 ]. |
|
602 |
|
603 ^ methods |
|
604 |
|
605 "Created: / 25.10.1997 / 18:58:25 / cg" |
|
606 "Modified: / 26.10.1997 / 15:06:18 / cg" |
|
607 ! |
|
608 |
|
609 aspectSelectorsAndTypesDo:aTwoArgBlock |
|
610 "evaluate aBlock for every aspect methods selector; 2nd arg describes the aspects type" |
|
611 |
|
612 |cls methods selector protoSpec| |
|
613 |
|
614 className isNil ifTrue:[ |
|
615 self warn:'No class defined !!'. |
|
616 ^ self |
|
617 ]. |
|
618 |
|
619 cls := self resolveName:className. |
|
620 |
585 treeView propertiesDo:[:aProp| |
621 treeView propertiesDo:[:aProp| |
586 |selector| |
622 |selector| |
587 |
623 |
588 (selector := aProp model) notNil ifTrue:[ |
624 (selector := aProp model) notNil ifTrue:[ |
589 selector isArray ifFalse:[ |
625 selector isArray ifFalse:[ |
590 selector := selector asSymbol. |
626 aTwoArgBlock value:(selector asSymbol) value:#modelAspect |
591 (cls includesSelector:selector) ifTrue:[ |
|
592 skip := false. |
|
593 (cls isSubclassOf:SimpleDialog) ifTrue:[ |
|
594 skip := SimpleDialog includesSelector:selector asSymbol |
|
595 ]. |
|
596 skip ifFalse:[ |
|
597 methods add:(cls compiledMethodAt:selector) |
|
598 ]. |
|
599 ]. |
|
600 ]. |
627 ]. |
601 ]. |
628 ]. |
602 |
629 |
603 (selector := aProp menu) notNil ifTrue:[ |
630 (selector := aProp menu) notNil ifTrue:[ |
604 selector isArray ifFalse:[ |
631 selector isArray ifFalse:[ |
605 selector := selector asSymbol. |
632 aTwoArgBlock value:(selector asSymbol) value:#menu |
606 (cls includesSelector:selector) ifTrue:[ |
|
607 methods add:(cls compiledMethodAt:selector) |
|
608 ] |
|
609 ]. |
633 ]. |
610 ]. |
634 ]. |
611 |
635 |
612 (aProp spec aspectSelectors) do:[:aSel | |
636 (aProp spec aspectSelectors) do:[:aSel | |
613 |selector| |
|
614 |
|
615 aSel isArray ifFalse:[ |
637 aSel isArray ifFalse:[ |
616 selector := aSel asSymbol. |
638 aTwoArgBlock value:(aSel asSymbol) value:#channelAspect |
617 (cls includesSelector:selector) ifTrue:[ |
|
618 methods add:(cls compiledMethodAt:selector) |
|
619 ] |
|
620 ]. |
639 ]. |
621 ]. |
640 ]. |
622 aProp spec actionSelectors do:[:aSel| |
641 aProp spec actionSelectors do:[:aSel| |
623 |selector| |
|
624 |
|
625 aSel isArray ifFalse:[ |
642 aSel isArray ifFalse:[ |
626 selector := aSel asSymbol. |
643 aTwoArgBlock value:(aSel asSymbol) value:#actionSelector |
627 (cls includesSelector:selector) ifTrue:[ |
|
628 methods add:(cls compiledMethodAt:selector) |
|
629 ] |
|
630 ]. |
644 ]. |
631 ]. |
645 ]. |
632 aProp spec valueSelectors do:[:aSel| |
646 aProp spec valueSelectors do:[:aSel| |
633 |selector| |
|
634 |
|
635 aSel isArray ifFalse:[ |
647 aSel isArray ifFalse:[ |
636 selector := aSel asSymbol. |
648 aTwoArgBlock value:(aSel asSymbol) value:#valueSelector |
637 (cls includesSelector:selector) ifTrue:[ |
|
638 methods add:(cls compiledMethodAt:selector) |
|
639 ] |
|
640 ]. |
649 ]. |
641 ] |
650 ] |
642 ]. |
651 ]. |
643 |
652 |
644 protoSpec := treeView canvasSpec. |
653 protoSpec := treeView canvasSpec. |
645 |
654 |
646 (selector := protoSpec menu) notNil ifTrue:[ |
655 (selector := protoSpec menu) notNil ifTrue:[ |
647 selector isArray ifFalse:[ |
656 selector isArray ifFalse:[ |
648 selector := selector asSymbol. |
657 aTwoArgBlock value:(selector asSymbol) value:#menu |
649 (cls includesSelector:selector) ifTrue:[ |
|
650 methods add:(cls compiledMethodAt:selector) |
|
651 ] |
|
652 ]. |
658 ]. |
653 ]. |
659 ]. |
654 |
660 |
655 ^ methods |
661 ^ methods |
656 |
|
657 "Created: / 25.10.1997 / 18:58:25 / cg" |
|
658 "Modified: / 26.10.1997 / 15:06:18 / cg" |
|
659 ! |
662 ! |
660 |
663 |
661 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
664 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
662 |selector args showIt code alreadyInSuperclass numArgs method| |
665 |selector args showIt code alreadyInSuperclass numArgs method| |
663 |
666 |
716 code := code , |
719 code := code , |
717 '!! !!\\'. |
720 '!! !!\\'. |
718 ^ code withCRs |
721 ^ code withCRs |
719 |
722 |
720 "Modified: / 25.10.1997 / 19:18:50 / cg" |
723 "Modified: / 25.10.1997 / 19:18:50 / cg" |
|
724 ! |
|
725 |
|
726 generateAspectMethodCode |
|
727 "generate aspect, action & menu methods |
|
728 - but do not overwrite existing ones. |
|
729 Return a string ready to compile into the application class." |
|
730 |
|
731 ^ self generateAspectMethodCodeFiltering:nil |
|
732 ! |
|
733 |
|
734 generateAspectMethodCodeFiltering:aFilterOrEmpty |
|
735 "generate aspect, action & menu methods |
|
736 - but do not overwrite existing ones. |
|
737 Return a string ready to compile into the application class." |
|
738 |
|
739 |cls codePieces skip protoSpec thisCode |
|
740 definedMethodSelectors iVars t exportSels| |
|
741 |
|
742 cls := self targetClass. |
|
743 cls isNil ifTrue:[ |
|
744 ^ nil |
|
745 ]. |
|
746 |
|
747 codePieces := OrderedCollection new. |
|
748 definedMethodSelectors := IdentitySet new. |
|
749 |
|
750 treeView propertiesDo:[:aProp| |
|
751 |modelSelector| |
|
752 |
|
753 protoSpec := aProp spec. |
|
754 |
|
755 (modelSelector := aProp model) notNil ifTrue:[ |
|
756 self generateCodeFrom:(Array with:modelSelector) in:cls |
|
757 do:[:aSel| |
|
758 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
|
759 skip := false. |
|
760 |
|
761 (cls isSubclassOf:SimpleDialog) ifTrue:[ |
|
762 skip := SimpleDialog includesSelector:aSel |
|
763 ]. |
|
764 (definedMethodSelectors includes:aSel) ifTrue:[ |
|
765 skip := true. |
|
766 ]. |
|
767 |
|
768 skip ifFalse:[ |
|
769 "/ kludge .. |
|
770 "/ (protoSpec isKindOf:ActionButtonSpec) |
|
771 (protoSpec defaultModelIsCallBackMethodSelector:aSel) |
|
772 ifTrue:[ |
|
773 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
|
774 ] ifFalse:[ |
|
775 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
|
776 ]. |
|
777 codePieces add:thisCode. |
|
778 definedMethodSelectors add:aSel. |
|
779 Transcript showCR:'code generated for aspect: ' , aSel |
|
780 ] ifTrue:[ |
|
781 Transcript showCR:'*** no code generated for aspect: ' , aSel , ' (method already exists)' |
|
782 ]. |
|
783 ]. |
|
784 ]. |
|
785 ]. |
|
786 |
|
787 "/ for each aspect, generate getter (if not yet implemented) |
|
788 self generateCodeFrom:(aProp spec aspectSelectors) in:cls |
|
789 do:[:aSel| |
|
790 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
|
791 (definedMethodSelectors includes:aSel) ifFalse:[ |
|
792 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
|
793 codePieces add:thisCode. |
|
794 definedMethodSelectors add:aSel. |
|
795 Transcript showCR:'code generated for aspect: ' , aSel |
|
796 ] |
|
797 ] |
|
798 ]. |
|
799 |
|
800 "/ exported aspects - need setter methods |
|
801 exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol]. |
|
802 self generateCodeFrom:exportSels in:cls |
|
803 do:[:aSel| |
|
804 |aspect| |
|
805 |
|
806 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
|
807 (definedMethodSelectors includes:aSel) ifFalse:[ |
|
808 aspect := (aSel copyWithoutLast:1) asSymbol. |
|
809 thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls). |
|
810 codePieces add:thisCode. |
|
811 definedMethodSelectors add:aSel. |
|
812 Transcript showCR:'export code generated for aspect: ' , aSel |
|
813 ] |
|
814 ] |
|
815 ]. |
|
816 |
|
817 self generateCodeFrom:(aProp spec actionSelectors) in:cls |
|
818 do:[:aSel| |
|
819 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
|
820 (definedMethodSelectors includes:aSel) ifFalse:[ |
|
821 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
|
822 codePieces add:thisCode. |
|
823 definedMethodSelectors add:aSel. |
|
824 Transcript showCR:'action generated for aspect: ' , aSel |
|
825 ] |
|
826 ] |
|
827 ]. |
|
828 |
|
829 self generateCodeFrom:(aProp spec valueSelectors) in:cls |
|
830 do:[:aSel| |
|
831 (aFilterOrEmpty isNil or:[aFilterOrEmpty includes:aSel]) ifTrue:[ |
|
832 (definedMethodSelectors includes:aSel) ifFalse:[ |
|
833 "/ uppercase: - assume its a globals name. |
|
834 aSel first isUppercase ifFalse:[ |
|
835 thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). |
|
836 codePieces add:thisCode. |
|
837 definedMethodSelectors add:aSel. |
|
838 Transcript showCR:'code generated for aspect: ' , aSel |
|
839 ] |
|
840 ] |
|
841 ] |
|
842 ]. |
|
843 ]. |
|
844 |
|
845 AspectsAsInstances ifTrue:[ |
|
846 iVars := cls instVarNames asOrderedCollection. |
|
847 definedMethodSelectors do:[:ivar | |
|
848 (iVars includes:ivar) ifFalse:[ |
|
849 iVars add:ivar |
|
850 ] |
|
851 ]. |
|
852 iVars := iVars asArray. |
|
853 t := cls shallowCopy. |
|
854 t setInstanceVariableString:iVars asStringCollection asString. |
|
855 codePieces addFirst:(t definition , '!!\' withCRs). |
|
856 ]. |
|
857 |
|
858 ^ String |
|
859 streamContents: |
|
860 [:codeStream | |
|
861 codePieces do:[:eachPiece | codeStream nextPutAll:eachPiece]. |
|
862 ]. |
|
863 |
|
864 "Modified: / 29.7.1998 / 12:21:19 / cg" |
721 ! |
865 ! |
722 |
866 |
723 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass |
867 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass |
724 |modelClass modelValueString modelValue modelGen code| |
868 |modelClass modelValueString modelValue modelGen code| |
725 |
869 |
783 |
927 |
784 "Modified: / 29.7.1998 / 11:29:16 / cg" |
928 "Modified: / 29.7.1998 / 11:29:16 / cg" |
785 "Modified: / 22.9.1999 / 12:33:47 / stefan" |
929 "Modified: / 22.9.1999 / 12:33:47 / stefan" |
786 ! |
930 ! |
787 |
931 |
788 generateAspectMethods |
|
789 "generate aspect, action & menu methods |
|
790 - but do not overwrite existing ones. |
|
791 Return a string ready to compile into the application class." |
|
792 |
|
793 |cls code skip protoSpec thisCode |
|
794 definedMethodSelectors iVars t exportSels| |
|
795 |
|
796 definedMethodSelectors := IdentitySet new. |
|
797 |
|
798 code := ''. |
|
799 |
|
800 className isNil ifTrue:[ |
|
801 self warn:'Set first the class!!'. |
|
802 ^ code |
|
803 ]. |
|
804 |
|
805 (cls := self resolveName:className) isNil ifTrue:[ |
|
806 self warn:'Class ', className asString, ' does not exist!!'. |
|
807 ^ code |
|
808 ]. |
|
809 |
|
810 treeView propertiesDo:[:aProp| |
|
811 |modelSelector| |
|
812 |
|
813 protoSpec := aProp spec. |
|
814 |
|
815 (modelSelector := aProp model) notNil ifTrue:[ |
|
816 self generateCodeFrom:(Array with:modelSelector) in:cls |
|
817 do:[:aSel| |
|
818 |sym| |
|
819 |
|
820 sym := aSel asSymbol. |
|
821 skip := false. |
|
822 |
|
823 (cls isSubclassOf:SimpleDialog) ifTrue:[ |
|
824 skip := SimpleDialog includesSelector:sym |
|
825 ]. |
|
826 (definedMethodSelectors includes:sym) ifTrue:[ |
|
827 skip := true. |
|
828 ]. |
|
829 |
|
830 skip ifFalse:[ |
|
831 "/ kludge .. |
|
832 "/ (protoSpec isKindOf:ActionButtonSpec) |
|
833 (protoSpec defaultModelIsCallBackMethodSelector:aSel) |
|
834 ifTrue:[ |
|
835 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
|
836 ] ifFalse:[ |
|
837 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
|
838 ]. |
|
839 code := code, thisCode. |
|
840 definedMethodSelectors add:sym. |
|
841 Transcript showCR:'code generated for aspect: ' , sym |
|
842 ] ifTrue:[ |
|
843 Transcript showCR:'*** no code generated for aspect: ' , sym , ' (method already exists)' |
|
844 ]. |
|
845 ]. |
|
846 ]. |
|
847 |
|
848 "/ for each aspect, generate getter (if not yet implemented) |
|
849 self generateCodeFrom:(aProp spec aspectSelectors) in:cls |
|
850 do:[:aSel| |
|
851 |sym| |
|
852 |
|
853 sym := aSel asSymbol. |
|
854 (definedMethodSelectors includes:sym) ifFalse:[ |
|
855 thisCode := (self generateAspectMethodFor:aSel spec:protoSpec inClass:cls). |
|
856 code := code , thisCode. |
|
857 definedMethodSelectors add:sym. |
|
858 Transcript showCR:'code generated for aspect: ' , sym |
|
859 ] |
|
860 ]. |
|
861 |
|
862 "/ exported aspects - need setter methods |
|
863 exportSels := (treeView exportedAspects ? #()) collect:[:entry | (entry subAspect , ':') asSymbol]. |
|
864 self generateCodeFrom:exportSels in:cls |
|
865 do:[:aSel| |
|
866 |sym aspect| |
|
867 |
|
868 sym := aSel asSymbol. |
|
869 (definedMethodSelectors includes:sym) ifFalse:[ |
|
870 aspect := (aSel copyWithoutLast:1) asSymbol. |
|
871 thisCode := (self generateAspectSetMethodFor:aspect spec:protoSpec inClass:cls). |
|
872 code := code , thisCode. |
|
873 definedMethodSelectors add:sym. |
|
874 Transcript showCR:'export code generated for aspect: ' , sym |
|
875 ] |
|
876 ]. |
|
877 |
|
878 self generateCodeFrom:(aProp spec actionSelectors) in:cls |
|
879 do:[:aSel| |
|
880 |sym| |
|
881 |
|
882 sym := aSel asSymbol. |
|
883 (definedMethodSelectors includes:sym) ifFalse:[ |
|
884 thisCode := (self generateActionMethodFor:aSel spec:protoSpec inClass:cls). |
|
885 code := code , thisCode. |
|
886 definedMethodSelectors add:sym. |
|
887 Transcript showCR:'action generated for aspect: ' , sym |
|
888 ] |
|
889 ]. |
|
890 |
|
891 self generateCodeFrom:(aProp spec valueSelectors) in:cls |
|
892 do:[:aSel| |
|
893 |sym| |
|
894 |
|
895 sym := aSel asSymbol. |
|
896 (definedMethodSelectors includes:sym) ifFalse:[ |
|
897 "/ uppercase: - assume its a globals name. |
|
898 aSel first isUppercase ifFalse:[ |
|
899 thisCode := (self generateValueMethodFor:aSel spec:protoSpec inClass:cls). |
|
900 code := code , thisCode. |
|
901 definedMethodSelectors add:sym. |
|
902 Transcript showCR:'code generated for aspect: ' , sym |
|
903 ] |
|
904 ] |
|
905 ]. |
|
906 ]. |
|
907 |
|
908 AspectsAsInstances ifTrue:[ |
|
909 iVars := cls instVarNames asOrderedCollection. |
|
910 definedMethodSelectors do:[:ivar | |
|
911 (iVars includes:ivar) ifFalse:[ |
|
912 iVars add:ivar |
|
913 ] |
|
914 ]. |
|
915 iVars := iVars asArray. |
|
916 t := cls shallowCopy. |
|
917 t setInstanceVariableString:iVars asStringCollection asString. |
|
918 code := (t definition) , '!!\' withCRs , code. |
|
919 ]. |
|
920 ^ code |
|
921 |
|
922 "Modified: / 29.7.1998 / 12:21:19 / cg" |
|
923 ! |
|
924 |
|
925 generateAspectSelectorsMethod |
932 generateAspectSelectorsMethod |
926 "generate aspectSelectors method. |
933 "generate aspectSelectors method. |
927 Return a string ready to compile into the application class." |
934 Return a string ready to compile into the application class." |
928 |
935 |
929 |cls code spec| |
936 |cls code spec| |
930 |
937 |
931 className isNil ifTrue:[ |
938 cls := self targetClass. |
932 self warn:'Set first the class!!'. |
939 cls isNil ifTrue:[ |
933 ^ nil |
940 ^ nil |
934 ]. |
941 ]. |
935 |
942 |
936 (cls := self resolveName:className) isNil ifTrue:[ |
|
937 self warn:'Class ', className asString, ' does not exist!!'. |
|
938 ^ nil |
|
939 ]. |
|
940 spec := treeView exportedAspects. |
943 spec := treeView exportedAspects. |
941 spec size == 0 ifTrue:[^ nil]. |
944 spec size == 0 ifTrue:[^ nil]. |
942 |
945 |
943 "/ make it an array ... |
946 "/ make it an array ... |
944 spec := spec collect:[:entry | |subAspect type| |
947 spec := spec collect:[:entry | |subAspect type| |
1018 generateCodeFrom:aListOfSelectors in:aClass do:aBlock |
1021 generateCodeFrom:aListOfSelectors in:aClass do:aBlock |
1019 |
1022 |
1020 self class redefineAspectMethods ifTrue:[ |
1023 self class redefineAspectMethods ifTrue:[ |
1021 aListOfSelectors do:[:aSelector| |
1024 aListOfSelectors do:[:aSelector| |
1022 (aSelector isArray or:[aClass includesSelector:aSelector]) ifFalse:[ |
1025 (aSelector isArray or:[aClass includesSelector:aSelector]) ifFalse:[ |
1023 aBlock value:aSelector |
1026 aBlock value:aSelector asSymbol |
1024 ] ifTrue:[ |
1027 ] ifTrue:[ |
1025 Transcript showCR:'#' , aSelector , ' skipped - already implemented in the class' |
1028 Transcript showCR:'#' , aSelector , ' skipped - already implemented in the class' |
1026 ] |
1029 ] |
1027 ] |
1030 ] |
1028 ] ifFalse:[ |
1031 ] ifFalse:[ |
1029 aListOfSelectors do:[:aSelector| |
1032 aListOfSelectors do:[:aSelector| |
1030 aSelector isArray ifFalse:[ |
1033 aSelector isArray ifFalse:[ |
1031 (aClass canUnderstand:aSelector) ifFalse:[ |
1034 (aClass canUnderstand:aSelector) ifFalse:[ |
1032 aBlock value:aSelector |
1035 aBlock value:aSelector asSymbol |
1033 ] ifTrue:[ |
1036 ] ifTrue:[ |
1034 Transcript showCR:'#' , aSelector , ' skipped - already implemented in the class (or superclass)' |
1037 Transcript showCR:'#' , aSelector , ' skipped - already implemented in the class (or superclass)' |
1035 ] |
1038 ] |
1036 ] |
1039 ] |
1037 ] |
1040 ] |