69 |
71 |
70 !UIPainterView class methodsFor:'code generation mode'! |
72 !UIPainterView class methodsFor:'code generation mode'! |
71 |
73 |
72 generateAspectsAsInstanceVariables |
74 generateAspectsAsInstanceVariables |
73 "if on, aspects are held as instance variables; |
75 "if on, aspects are held as instance variables; |
74 if off (the default), they are kept in the bindings dictionary. |
76 if off (the default), they are kept in the bindings dictionary." |
75 " |
77 |
76 ^ AspectsAsInstances |
78 ^ AspectsAsInstances |
77 |
79 |
78 "Created: / 29.7.1998 / 11:21:38 / cg" |
80 "Created: / 29.7.1998 / 11:21:38 / cg" |
79 "Modified: / 29.7.1998 / 11:22:01 / cg" |
81 "Modified: / 29.7.1998 / 11:22:01 / cg" |
80 ! |
82 ! |
81 |
83 |
82 generateAspectsAsInstanceVariables:aBoolean |
84 generateAspectsAsInstanceVariables:aBoolean |
83 "if on, aspects are held as instance variables; |
85 "if on, aspects are held as instance variables; |
84 if off (the default), they are kept in the bindings dictionary. |
86 if off (the default), they are kept in the bindings dictionary." |
85 " |
87 |
86 AspectsAsInstances := aBoolean |
88 AspectsAsInstances := aBoolean |
87 |
89 |
88 "Created: / 29.7.1998 / 11:21:26 / cg" |
90 "Created: / 29.7.1998 / 11:21:26 / cg" |
89 "Modified: / 29.7.1998 / 11:22:11 / cg" |
91 "Modified: / 29.7.1998 / 11:22:11 / cg" |
90 ! |
92 ! |
91 |
93 |
|
94 generateCommentedCode |
|
95 "comments in generated aspect methods; yes or no." |
|
96 |
|
97 ^ GenerateCommentedCode ? true |
|
98 |
|
99 "Modified: / 12-01-2008 / 10:21:06 / cg" |
|
100 ! |
|
101 |
|
102 generateCommentedCode:aBoolean |
|
103 "comments in generated aspect methods; yes or no." |
|
104 |
|
105 GenerateCommentedCode := aBoolean |
|
106 ! |
|
107 |
92 redefineAspectMethods |
108 redefineAspectMethods |
93 "redefine methods yes or no. If a method is defined in super class |
109 "redefine methods yes or no. |
94 should the message be reinstalled ? |
110 If a method is defined in super class should the message be reinstalled ?" |
95 " |
111 |
96 ^ RedefineAspectMethods |
112 ^ RedefineAspectMethods |
97 |
113 |
98 "Modified: / 22.9.1999 / 12:33:03 / stefan" |
114 "Modified: / 22.9.1999 / 12:33:03 / stefan" |
99 ! |
115 ! |
100 |
116 |
101 redefineAspectMethods:aBoolean |
117 redefineAspectMethods:aBoolean |
102 "redefine methods yes or no. If a method is defined in super class |
118 "redefine methods yes or no. |
103 should the message be reinstalled ? |
119 If a method is defined in super class should the message be reinstalled ?" |
104 " |
120 |
105 RedefineAspectMethods := aBoolean |
121 RedefineAspectMethods := aBoolean |
106 |
|
107 |
|
108 ! ! |
122 ! ! |
109 |
123 |
110 !UIPainterView class methodsFor:'defaults'! |
124 !UIPainterView class methodsFor:'defaults'! |
111 |
125 |
112 defaultMenuMessage |
126 defaultMenuMessage |
595 |
609 |
596 "Modified: / 18-03-1999 / 18:29:43 / stefan" |
610 "Modified: / 18-03-1999 / 18:29:43 / stefan" |
597 "Created: / 13-10-2006 / 16:09:27 / cg" |
611 "Created: / 13-10-2006 / 16:09:27 / cg" |
598 ! ! |
612 ! ! |
599 |
613 |
|
614 !UIPainterView methodsFor:'drawing'! |
|
615 |
|
616 clearRectangle:visRect |
|
617 super clearRectangle:visRect. |
|
618 sketchPainter notNil ifTrue:[ |
|
619 sketchPainter redrawInTargetView |
|
620 ]. |
|
621 |
|
622 "Created: / 16-01-2008 / 17:52:27 / cg" |
|
623 ! |
|
624 |
|
625 clearView |
|
626 super clearView. |
|
627 sketchPainter notNil ifTrue:[ |
|
628 sketchPainter redrawInTargetView |
|
629 ]. |
|
630 |
|
631 "Created: / 16-01-2008 / 17:46:08 / cg" |
|
632 ! |
|
633 |
|
634 useSketch:aFilename |
|
635 sketchPainter := TOPFileDrawer new. |
|
636 sketchPainter targetView:self. |
|
637 sketchPainter readFile:aFilename. |
|
638 sketchPainter ajustSketch. |
|
639 self invalidate. |
|
640 |
|
641 "Created: / 16-01-2008 / 17:46:26 / cg" |
|
642 ! ! |
|
643 |
600 !UIPainterView methodsFor:'event handling'! |
644 !UIPainterView methodsFor:'event handling'! |
601 |
645 |
602 keyPress:key x:x y:y view:aView |
646 keyPress:key x:x y:y view:aView |
603 "a delegated keyEvent from aView" |
647 "a delegated keyEvent from aView" |
604 |
648 |
713 ]. |
757 ]. |
714 ]. |
758 ]. |
715 ! |
759 ! |
716 |
760 |
717 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
761 generateActionMethodFor:aspect spec:protoSpec inClass:targetClass |
718 |selector args showIt code alreadyInSuperclass numArgs method| |
762 |selector args showIt codeStream alreadyInSuperclass numArgs method| |
719 |
763 |
720 selector := aspect asSymbol. |
764 selector := aspect asSymbol. |
721 |
765 |
722 alreadyInSuperclass := targetClass superclass canUnderstand:selector. |
766 alreadyInSuperclass := targetClass superclass canUnderstand:selector. |
723 |
767 |
724 numArgs := selector numArgs. |
768 numArgs := selector numArgs. |
725 method := aspect. |
769 method := aspect. |
726 |
770 |
727 numArgs == 1 ifTrue:[ |
771 numArgs == 1 ifTrue:[ |
728 args := 'anArgument'. |
772 args := 'anArgument'. |
729 showIt := ''' , anArgument printString , '' ...''.\'. |
773 showIt := ''' , anArgument printString , '' ...''.'. |
730 ] ifFalse:[ |
774 ] ifFalse:[ |
731 args := ''. |
775 args := ''. |
732 showIt := ' ...''.\'. |
776 showIt := ' ...''.'. |
733 |
777 |
734 numArgs ~~ 0 ifTrue:[ |
778 numArgs ~~ 0 ifTrue:[ |
735 method := ''. |
779 method := ''. |
736 |
780 |
737 selector keywords keysAndValuesDo:[:i :key| |
781 selector keywords keysAndValuesDo:[:i :key| |
738 method := method, key, 'arg', i printString, ' ' |
782 method := method, key, 'arg', i printString, ' ' |
739 ] |
783 ] |
740 ] |
784 ] |
741 ]. |
785 ]. |
742 |
786 codeStream := WriteStream on:(String new:100). |
743 code := '!!' , targetClass name , ' methodsFor:''actions''!!\\' , |
787 codeStream |
744 method , args , '\' , |
788 nextPutLine:('!!',targetClass name,' methodsFor:''actions''!!'); |
745 ' "automatically generated by UIPainter ..."\\' , |
789 nextPutLine:(method,args); |
746 ' "*** the code below performs no action"\' , |
790 nextPutLine:' <resource: #uiCallback>'; |
747 ' "*** (except for some feedback on the Transcript)"\' , |
791 cr. |
748 ' "*** Please change as required and accept in the browser."\' , |
792 |
749 '\' . |
793 self class generateCommentedCode ifTrue:[ |
|
794 codeStream |
|
795 nextPutAll:' "automatically generated by UIPainter ..." |
|
796 |
|
797 "*** the code below performs no action" |
|
798 "*** (except for some feedback on the Transcript)" |
|
799 "*** Please change as required and accept in the browser." |
|
800 "*** (and replace this comment by something more useful ;-)" |
|
801 |
|
802 '. |
|
803 |
|
804 alreadyInSuperclass ifTrue:[ |
|
805 codeStream |
|
806 nextPutLine:' "action for ' , aspect , ' is already provided in a superclass."'; |
|
807 nextPutLine:' "It may be redefined here..."'; |
|
808 cr. |
|
809 ] ifFalse:[ |
|
810 codeStream |
|
811 nextPutLine:' "action to be defined here..."'; |
|
812 cr. |
|
813 ]. |
|
814 ]. |
|
815 |
|
816 codeStream |
|
817 nextPutAll:' Transcript showCR:self class name, '': '. |
750 |
818 |
751 alreadyInSuperclass ifTrue:[ |
819 alreadyInSuperclass ifTrue:[ |
752 code := code , |
820 codeStream |
753 ' "action for ' , aspect , ' is already provided in a superclass."\' , |
821 nextPutAll:'inherited '. |
754 ' "It may be redefined here ..."\\'. |
822 ]. |
755 ] ifFalse:[ |
823 codeStream |
756 code := code , |
824 nextPutAll:'action for '; |
757 ' "action to be added ..."\\'. |
825 nextPutAll:aspect; |
758 ]. |
826 nextPutLine:showIt. |
759 |
827 |
760 code := code , |
|
761 ' Transcript showCR:self class name, '': '. |
|
762 alreadyInSuperclass ifTrue:[ |
828 alreadyInSuperclass ifTrue:[ |
763 code := code , 'inherited '. |
829 codeStream |
764 ]. |
830 nextPutAll:' super '; |
765 code := code , 'action for ' , aspect , showIt. |
831 nextPutAll:aspect; |
766 |
832 nextPutAll:args; |
767 alreadyInSuperclass ifTrue:[ |
833 nextPutLine:'.'. |
768 code := code , |
834 ]. |
769 ' super ' , aspect , args , '.\'. |
835 |
770 ]. |
836 codeStream |
771 |
837 nextPutLine:'!! !!'; cr. |
772 code := code , |
838 |
773 '!! !!\\'. |
839 ^ codeStream contents. |
774 ^ code withCRs |
840 |
775 |
841 "Modified: / 12-01-2008 / 10:21:52 / cg" |
776 "Modified: / 25.10.1997 / 19:18:50 / cg" |
|
777 ! |
842 ! |
778 |
843 |
779 generateAspectMethodCode |
844 generateAspectMethodCode |
780 "generate aspect, action & menu methods |
845 "generate aspect, action & menu methods |
781 - but do not overwrite existing ones. |
846 - but do not overwrite existing ones. |
916 |
981 |
917 "Modified: / 29.7.1998 / 12:21:19 / cg" |
982 "Modified: / 29.7.1998 / 12:21:19 / cg" |
918 ! |
983 ! |
919 |
984 |
920 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass |
985 generateAspectMethodFor:aspect spec:protoSpec inClass:targetClass |
921 |modelClass modelValueString modelValue modelGen code| |
986 |modelClass modelValueString modelValue modelGen codeStream| |
922 |
987 |
923 modelClass := protoSpec defaultModelClassFor:aspect. |
988 modelClass := protoSpec defaultModelClassFor:aspect. |
924 modelValueString := protoSpec defaultModelValueStringFor:aspect. |
989 modelValueString := protoSpec defaultModelValueStringFor:aspect. |
925 modelValueString notNil ifTrue:[ |
990 modelValueString notNil ifTrue:[ |
926 modelGen := modelValueString |
991 modelGen := modelValueString |
927 ] ifFalse:[ |
992 ] ifFalse:[ |
928 modelValue := protoSpec defaultModelValueFor:aspect. |
993 modelValue := protoSpec defaultModelValueFor:aspect. |
929 modelValue isNil ifTrue:[ |
994 modelValue isNil ifTrue:[ |
930 modelGen := modelClass name , ' new' |
995 modelGen := modelClass name , ' new' |
931 ] ifFalse:[ |
996 ] ifFalse:[ |
932 modelGen := modelValue storeString , ' asValue' |
997 modelGen := modelValue storeString , ' asValue' |
933 ]. |
998 ]. |
934 |
999 |
935 ]. |
1000 ]. |
936 |
1001 |
937 code := '!!' , targetClass name , ' methodsFor:''aspects''!!\\' , |
1002 codeStream := WriteStream on:(String new:100). |
938 aspect , '\' , |
1003 codeStream |
939 ' "automatically generated by UIPainter ..."\\' , |
1004 nextPutLine:('!!' , targetClass name , ' methodsFor:''aspects''!!'); |
940 ' "*** the code below creates a default model when invoked."\' , |
1005 nextPutLine:aspect; |
941 ' "*** (which may not be the one you wanted)"\' , |
1006 nextPutLine:' <resource: #uiAspect>'; |
942 ' "*** Please change as required and accept it in the browser."\' , |
1007 cr. |
943 ' "*** (and replace this comment by something more useful ;-)"\' . |
1008 |
944 |
1009 self class generateCommentedCode ifTrue:[ |
|
1010 codeStream |
|
1011 nextPutAll:' "automatically generated by UIPainter ..." |
|
1012 |
|
1013 "*** the code below creates a default model when invoked." |
|
1014 "*** (which may not be the one you wanted)" |
|
1015 "*** Please change as required and accept it in the browser." |
|
1016 "*** (and replace this comment by something more useful ;-)" |
|
1017 |
|
1018 '. |
|
1019 ]. |
945 |
1020 |
946 AspectsAsInstances ifTrue:[ |
1021 AspectsAsInstances ifTrue:[ |
947 code := code , '\' , |
1022 codeStream |
948 ' ' , aspect , ' isNil ifTrue:[\' , |
1023 nextPutLine:(' ',aspect,' isNil ifTrue:['); |
949 ' ' , aspect , ' := ' , modelGen , '.\'. |
1024 nextPutLine:(' ',aspect,' := ',modelGen,'.'). |
950 modelClass ~~ TriggerValue ifTrue:[ |
1025 |
951 code := code , |
1026 modelClass ~~ TriggerValue ifTrue:[ |
952 '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' , |
1027 self class generateCommentedCode ifTrue:[ |
953 '"/ ' , aspect , ' addDependent:self.\' , |
1028 codeStream |
954 '"/ ' , aspect , ' onChangeSend:#', aspect ,'Changed to:self.\'. |
1029 nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'. |
955 ]. |
1030 ]. |
956 code := code , |
1031 codeStream |
957 ' ].\' , |
1032 nextPutLine:'"/ ',aspect,' addDependent:self.'; |
958 ' ^ ' , aspect ,'.\' , |
1033 nextPutLine:'"/ ',aspect,' onChangeSend:#',aspect,'Changed to:self.'. |
959 '!! !!\\' |
1034 ]. |
|
1035 codeStream |
|
1036 nextPutLine:' ].'; |
|
1037 nextPutLine:' ^ ',aspect,'.'. |
960 ] ifFalse:[ |
1038 ] ifFalse:[ |
961 code := code , '\' , |
1039 codeStream |
962 ' |holder|\' , |
1040 nextPutLine:(' |holder|'); |
963 '\' , |
1041 cr; |
964 ' (holder := builder bindingAt:#' , aspect , ') isNil ifTrue:[\' , |
1042 nextPutLine:(' (holder := builder bindingAt:#',aspect,') isNil ifTrue:['); |
965 ' holder := ', modelGen, '.\', |
1043 nextPutLine:(' holder := ',modelGen,'.'); |
966 ' builder aspectAt:#' , aspect , ' put:holder.\'. |
1044 nextPutLine:(' builder aspectAt:#',aspect,' put:holder.'). |
967 modelClass ~~ TriggerValue ifTrue:[ |
1045 |
968 code := code , |
1046 modelClass ~~ TriggerValue ifTrue:[ |
969 '"/ if your app needs to be notified of changes, uncomment one of the lines below:\' , |
1047 self class generateCommentedCode ifTrue:[ |
970 '"/ holder addDependent:self.\' , |
1048 codeStream |
971 '"/ holder onChangeSend:#', aspect ,'Changed to:self.\'. |
1049 nextPutLine:'"/ if your app needs to be notified of changes, uncomment one of the lines below:'. |
972 ]. |
1050 ]. |
973 code := code , |
1051 codeStream |
974 ' ].\' , |
1052 nextPutLine:'"/ holder addDependent:self.'; |
975 ' ^ holder.\' , |
1053 nextPutLine:'"/ holder onChangeSend:#',aspect,'Changed to:self.'. |
976 '!! !!\\' |
1054 ]. |
977 ]. |
1055 codeStream |
978 |
1056 nextPutLine:' ].'; |
979 ^ code withCRs |
1057 nextPutLine:' ^ holder.'. |
980 |
1058 ]. |
981 "Modified: / 29.7.1998 / 11:29:16 / cg" |
1059 |
982 "Modified: / 22.9.1999 / 12:33:47 / stefan" |
1060 codeStream |
|
1061 nextPutLine:'!! !!'; cr. |
|
1062 "/ self halt. |
|
1063 ^ codeStream contents. |
|
1064 |
|
1065 "Modified: / 22-09-1999 / 12:33:47 / stefan" |
|
1066 "Modified: / 12-01-2008 / 10:21:43 / cg" |
983 ! |
1067 ! |
984 |
1068 |
985 generateAspectSelectorsMethod |
1069 generateAspectSelectorsMethod |
986 "generate aspectSelectors method. |
1070 "generate aspectSelectors method. |
987 Return a string ready to compile into the application class." |
1071 Return a string ready to compile into the application class." |
1439 |
1523 |
1440 ^ code withCRs |
1524 ^ code withCRs |
1441 |
1525 |
1442 "Modified: / 5.9.1995 / 21:01:35 / claus" |
1526 "Modified: / 5.9.1995 / 21:01:35 / claus" |
1443 "Modified: / 15.10.1998 / 11:29:53 / cg" |
1527 "Modified: / 15.10.1998 / 11:29:53 / cg" |
|
1528 ! |
|
1529 |
|
1530 listOfAspects |
|
1531 |cls aspects| |
|
1532 |
|
1533 aspects := IdentitySet new. |
|
1534 |
|
1535 cls := self targetClass. |
|
1536 cls notNil ifTrue:[ |
|
1537 cls methodsDo:[:m | |
|
1538 ((m resources ? #()) includesAny:#(uiAspect)) ifTrue:[ |
|
1539 aspects add:m selector |
|
1540 ]. |
|
1541 ] |
|
1542 ]. |
|
1543 |
|
1544 treeView propertiesDo:[:aProp| |
|
1545 |modelSelector| |
|
1546 |
|
1547 (modelSelector := aProp model) notNil ifTrue:[ |
|
1548 aspects add:modelSelector asSymbol |
|
1549 ]. |
|
1550 |
|
1551 "/ aspects addAll:aProp spec actionSelectors. |
|
1552 aspects addAll:aProp spec valueSelectors. |
|
1553 aspects addAll:aProp spec aspectSelectors. |
|
1554 ]. |
|
1555 |
|
1556 ^ aspects asOrderedCollection sort. |
|
1557 |
|
1558 "Created: / 12-01-2008 / 19:24:45 / cg" |
|
1559 ! |
|
1560 |
|
1561 listOfCallbacks |
|
1562 |cls aspects| |
|
1563 |
|
1564 aspects := IdentitySet new. |
|
1565 |
|
1566 cls := self targetClass. |
|
1567 cls notNil ifTrue:[ |
|
1568 cls methodsDo:[:m | |
|
1569 ((m resources ? #()) includesAny:#(uiCallback)) ifTrue:[ |
|
1570 aspects add:m selector |
|
1571 ]. |
|
1572 ] |
|
1573 ]. |
|
1574 |
|
1575 treeView propertiesDo:[:aProp| |
|
1576 |modelSelector| |
|
1577 |
|
1578 aspects addAll:aProp spec actionSelectors. |
|
1579 "/ aspects addAll:aProp spec valueSelectors. |
|
1580 "/ aspects addAll:aProp spec aspectSelectors. |
|
1581 ]. |
|
1582 |
|
1583 ^ aspects asOrderedCollection sort. |
|
1584 |
|
1585 "Created: / 12-01-2008 / 19:25:19 / cg" |
1444 ! |
1586 ! |
1445 |
1587 |
1446 targetClass |
1588 targetClass |
1447 |cls| |
1589 |cls| |
1448 |
1590 |