645 "Created: 14.9.1995 / 10:55:20 / claus" |
645 "Created: 14.9.1995 / 10:55:20 / claus" |
646 "Modified: 14.9.1995 / 10:59:31 / claus" |
646 "Modified: 14.9.1995 / 10:59:31 / claus" |
647 ! |
647 ! |
648 |
648 |
649 classCategoryFileOut |
649 classCategoryFileOut |
|
650 "create a file 'categoryName.st' consisting of all classes in current category |
|
651 into the current projects defaultDirectory." |
|
652 |
|
653 self classCategoryFileOutAsk:false |
|
654 |
|
655 "Modified: 11.10.1997 / 16:47:46 / cg" |
|
656 ! |
|
657 |
|
658 classCategoryFileOutAs |
|
659 "create a file consisting of all classes in the current category |
|
660 into a file as user-specified." |
|
661 |
|
662 self classCategoryFileOutAsk:true |
|
663 |
|
664 "Modified: 11.10.1997 / 16:38:56 / cg" |
|
665 "Created: 11.10.1997 / 16:44:35 / cg" |
|
666 ! |
|
667 |
|
668 classCategoryFileOutAsk:doAsk |
650 "create a file 'categoryName' consisting of all classes in current category" |
669 "create a file 'categoryName' consisting of all classes in current category" |
651 |
670 |
652 |aStream fileName| |
671 |aStream fileName| |
653 |
672 |
654 self checkClassCategorySelected ifFalse:[^ self]. |
673 self checkClassCategorySelected ifFalse:[^ self]. |
655 (currentClassCategory startsWith:'*') ifTrue:[ |
674 (currentClassCategory startsWith:'*') ifTrue:[ |
656 self warn:(resources string:'try a real category'). |
675 self warn:(resources string:'try a real category'). |
657 ^ self |
676 ^ self |
658 ]. |
677 ]. |
659 |
678 |
660 fileName := currentClassCategory asString. |
679 fileName := currentClassCategory asString , '.st'. |
661 fileName replaceAll:Character space with:$_. |
680 fileName replaceAll:Character space with:$_. |
662 " |
|
663 this test allows a smalltalk to be built without Projects/ChangeSets |
|
664 " |
|
665 Project notNil ifTrue:[ |
|
666 fileName := Project currentProjectDirectory , fileName. |
|
667 ]. |
|
668 |
681 |
669 self withBusyCursorDo:[ |
682 self withBusyCursorDo:[ |
670 " |
683 |saveName fileBox dir| |
671 if file exists, save original in a .sav file |
684 |
672 " |
685 doAsk ifTrue:[ |
673 fileName asFilename exists ifTrue:[ |
686 fileBox := FileSelectionBox |
674 self busyLabel:'saving existing %1' with:fileName. |
687 title:(resources string:'fileOut %1 as:' with:currentClassCategory) |
675 fileName asFilename copyTo:(fileName , '.sav') |
688 okText:(resources string:'fileOut') |
676 ]. |
689 abortText:(resources string:'cancel') |
677 |
690 action:[:fileName | saveName := fileName]. |
678 aStream := FileStream newFileNamed:fileName. |
691 fileBox initialText:fileName. |
679 aStream isNil ifTrue:[ |
692 dir := FileSelectionBox lastFileSelectionDirectory. |
680 self warn:'cannot create: %1' with:fileName |
693 dir isNil ifTrue:[ |
681 ] ifFalse:[ |
694 " |
682 self busyLabel:'writing: %1' with:fileName. |
695 this test allows a smalltalk to be built without Projects/ChangeSets |
683 self allClassesInCategory:currentClassCategory inOrderDo:[:aClass | |
696 " |
684 aClass isPrivate ifFalse:[ |
697 Project notNil ifTrue:[ |
685 (self listOfNamespaces includesIdentical:aClass nameSpace) |
698 dir := Project currentProjectDirectory |
686 ifTrue:[ |
699 ] |
687 self busyLabel:'writing: %1' with:fileName. |
700 ]. |
688 aClass fileOutOn:aStream. |
701 dir notNil ifTrue:[ |
689 ] |
702 fileBox directory:dir. |
690 ] |
703 ]. |
691 ]. |
704 fileBox showAtPointer. |
692 aStream close. |
705 fileBox destroy. |
693 ] |
706 saveName isNil ifTrue:[ |
|
707 ^ self |
|
708 ]. |
|
709 saveName isEmpty ifTrue:[ |
|
710 self warn:'bad name given'. |
|
711 ^ self |
|
712 ]. |
|
713 FileSelectionBox lastFileSelectionDirectory:(saveName asFilename directoryName). |
|
714 fileName := saveName. |
|
715 ] ifFalse:[ |
|
716 " |
|
717 this test allows a smalltalk to be built without Projects/ChangeSets |
|
718 " |
|
719 Project notNil ifTrue:[ |
|
720 fileName := Project currentProjectDirectory , fileName. |
|
721 ]. |
|
722 ]. |
|
723 |
|
724 " |
|
725 if file exists, save original in a .sav file |
|
726 " |
|
727 fileName asFilename exists ifTrue:[ |
|
728 self busyLabel:'saving existing %1' with:fileName. |
|
729 fileName asFilename copyTo:(fileName , '.sav') |
|
730 ]. |
|
731 |
|
732 aStream := FileStream newFileNamed:fileName. |
|
733 aStream isNil ifTrue:[ |
|
734 self warn:'cannot create: %1' with:fileName |
|
735 ] ifFalse:[ |
|
736 self busyLabel:'writing: %1' with:fileName. |
|
737 self allClassesInCategory:currentClassCategory inOrderDo:[:aClass | |
|
738 aClass isPrivate ifFalse:[ |
|
739 (self listOfNamespaces includesIdentical:aClass nameSpace) |
|
740 ifTrue:[ |
|
741 self busyLabel:'writing: %1' with:fileName. |
|
742 aClass fileOutOn:aStream. |
|
743 ] |
|
744 ] |
|
745 ]. |
|
746 aStream close. |
|
747 ] |
694 ]. |
748 ]. |
695 self normalLabel. |
749 self normalLabel. |
696 |
750 |
697 "Modified: 18.8.1997 / 15:42:26 / cg" |
751 "Created: 11.10.1997 / 16:38:29 / cg" |
|
752 "Modified: 11.10.1997 / 16:48:19 / cg" |
698 ! |
753 ! |
699 |
754 |
700 classCategoryFileOutBinaryEach |
755 classCategoryFileOutBinaryEach |
701 "fileOut each class in the current category as binary bytecode." |
756 "fileOut each class in the current category as binary bytecode." |
702 |
757 |
856 <resource: #keyboard ( #Find #Cmdn) > |
911 <resource: #keyboard ( #Find #Cmdn) > |
857 |
912 |
858 |specialMenu m labels selectors shorties| |
913 |specialMenu m labels selectors shorties| |
859 |
914 |
860 currentClassCategory notNil ifTrue:[ |
915 currentClassCategory notNil ifTrue:[ |
861 labels := #( |
916 labels := #( |
862 'fileOut each binary ...' |
917 'fileOut each binary ...' |
863 '-' |
918 '-' |
864 'repository history ...' |
919 'repository history ...' |
865 'validate class revisions' |
920 'validate class revisions' |
866 '-' |
921 '-' |
867 'checkin each ...' |
922 'checkin each ...' |
868 ). |
923 ). |
869 selectors := #( |
924 selectors := #( |
870 classCategoryFileOutBinaryEach |
925 classCategoryFileOutBinaryEach |
871 nil |
926 nil |
872 classCategoryRepositoryHistory |
927 classCategoryRepositoryHistory |
873 classCategoryValidateClassRevisions |
928 classCategoryValidateClassRevisions |
874 nil |
929 nil |
875 classCategoryCheckinEach |
930 classCategoryCheckinEach |
876 ). |
931 ). |
877 ] ifFalse:[ |
932 ] ifFalse:[ |
878 labels := #( |
933 labels := #( |
879 'repository history ...' |
934 'repository history ...' |
880 ). |
935 ). |
881 selectors := #( |
936 selectors := #( |
882 classCategoryRepositoryHistory |
937 classCategoryRepositoryHistory |
883 ). |
938 ). |
884 ]. |
939 ]. |
885 |
940 |
886 specialMenu := PopUpMenu |
941 specialMenu := PopUpMenu |
887 labels:(resources array:labels) |
942 labels:(resources array:labels) |
888 selectors:selectors |
943 selectors:selectors |
889 receiver:self. |
944 receiver:self. |
890 |
945 |
891 Smalltalk sourceCodeManager isNil ifTrue:[ |
946 Smalltalk sourceCodeManager isNil ifTrue:[ |
892 specialMenu disableAll:#(classCategoryRepositoryHistory |
947 specialMenu disableAll:#(classCategoryRepositoryHistory |
893 classCategoryCheckinEach |
948 classCategoryCheckinEach |
894 classCategoryValidateClassRevisions). |
949 classCategoryValidateClassRevisions). |
895 ]. |
950 ]. |
896 |
951 |
897 device ctrlDown ifTrue:[ |
952 device ctrlDown ifTrue:[ |
898 ^ specialMenu |
953 ^ specialMenu |
899 ]. |
954 ]. |
900 |
955 |
901 currentClassCategory isNil ifTrue:[ |
956 currentClassCategory isNil ifTrue:[ |
902 labels := #( |
957 labels := #( |
903 "/ 'namespace ...' |
958 "/ 'namespace ...' |
904 "/ '-' |
959 "/ '-' |
905 'clone' |
960 'clone' |
906 'open for class ...' |
961 'open for class ...' |
907 'spawn full class' |
962 'spawn full class' |
908 '-' |
963 '-' |
909 'update' |
964 'update' |
910 'find class ...' |
965 'find class ...' |
911 'find method ...' |
966 'find method ...' |
912 '-' |
967 '-' |
913 'new class category ...' |
968 'new class category ...' |
914 '=' |
969 '=' |
915 'others' |
970 'others' |
916 ). |
971 ). |
917 selectors := #( |
972 selectors := #( |
918 "/ namespaceDialog |
973 "/ namespaceDialog |
919 "/ nil |
974 "/ nil |
920 classCategoryClone |
975 classCategoryClone |
921 classCategoryOpenInClass |
976 classCategoryOpenInClass |
922 classCategorySpawnFullClass |
977 classCategorySpawnFullClass |
923 nil |
978 nil |
924 classCategoryUpdate |
979 classCategoryUpdate |
925 classCategoryFindClass |
980 classCategoryFindClass |
926 classCategoryFindMethod |
981 classCategoryFindMethod |
927 nil |
982 nil |
928 classCategoryNewCategory |
983 classCategoryNewCategory |
929 nil |
984 nil |
930 otherMenu |
985 otherMenu |
931 ). |
986 ). |
932 shorties := #( |
987 shorties := #( |
933 "/ nil |
988 "/ nil |
934 "/ nil |
989 "/ nil |
935 nil |
990 nil |
936 nil |
991 nil |
937 nil |
992 nil |
938 nil |
993 nil |
939 nil |
994 nil |
940 Find |
995 Find |
941 nil |
996 nil |
942 nil |
997 nil |
943 Cmdn |
998 Cmdn |
944 nil |
999 nil |
945 #'Ctrl' |
1000 #'Ctrl' |
946 ). |
1001 ). |
947 ] ifFalse:[ |
1002 ] ifFalse:[ |
948 labels := #( |
1003 labels := #( |
949 'fileOut' |
1004 'fileOut' |
950 'fileOut each' |
1005 'fileOut as ...' |
951 'printOut' |
1006 'fileOut each' |
952 'printOut protocol' |
1007 'printOut' |
953 '-' |
1008 'printOut protocol' |
|
1009 '-' |
954 "/ 'namespace ...' |
1010 "/ 'namespace ...' |
955 "/ '-' |
1011 "/ '-' |
956 'clone' |
1012 'clone' |
957 'open for class ...' |
1013 'open for class ...' |
958 'SPAWN_CATEGORY' |
1014 'SPAWN_CATEGORY' |
959 'spawn full class' |
1015 'spawn full class' |
960 '-' |
1016 '-' |
961 'update' |
1017 'update' |
962 'find class ...' |
1018 'find class ...' |
963 'find method ...' |
1019 'find method ...' |
964 '-' |
1020 '-' |
965 'new class category ...' |
1021 'new class category ...' |
966 'rename ...' |
1022 'rename ...' |
967 'remove' |
1023 'remove' |
968 '=' |
1024 '=' |
969 'others' |
1025 'others' |
970 ). |
1026 ). |
971 selectors := #( |
1027 selectors := #( |
972 classCategoryFileOut |
1028 classCategoryFileOut |
973 classCategoryFileOutEach |
1029 classCategoryFileOutAs |
974 classCategoryPrintOut |
1030 classCategoryFileOutEach |
975 classCategoryPrintOutProtocol |
1031 classCategoryPrintOut |
976 nil |
1032 classCategoryPrintOutProtocol |
|
1033 nil |
977 "/ namespaceDialog |
1034 "/ namespaceDialog |
978 "/ nil |
1035 "/ nil |
979 classCategoryClone |
1036 classCategoryClone |
980 classCategoryOpenInClass |
1037 classCategoryOpenInClass |
981 classCategorySpawn |
1038 classCategorySpawn |
982 classCategorySpawnFullClass |
1039 classCategorySpawnFullClass |
983 nil |
1040 nil |
984 classCategoryUpdate |
1041 classCategoryUpdate |
985 classCategoryFindClass |
1042 classCategoryFindClass |
986 classCategoryFindMethod |
1043 classCategoryFindMethod |
987 nil |
1044 nil |
988 classCategoryNewCategory |
1045 classCategoryNewCategory |
989 classCategoryRename |
1046 classCategoryRename |
990 classCategoryRemove |
1047 classCategoryRemove |
991 nil |
1048 nil |
992 otherMenu |
1049 otherMenu |
993 ). |
1050 ). |
994 shorties := #( |
1051 shorties := #( |
995 nil |
1052 nil |
996 nil |
1053 nil |
997 nil |
1054 nil |
998 nil |
1055 nil |
999 nil |
1056 nil |
1000 "/ nil |
1057 "/ nil |
1001 "/ nil |
1058 "/ nil |
1002 nil |
1059 nil |
1003 nil |
1060 nil |
1004 nil |
1061 nil |
1005 nil |
1062 nil |
1006 nil |
1063 nil |
1007 nil |
1064 nil |
1008 Find |
1065 Find |
1009 nil |
1066 nil |
1010 nil |
1067 nil |
1011 Cmdn |
1068 Cmdn |
1012 nil |
1069 nil |
1013 nil |
1070 nil |
1014 nil |
1071 nil |
1015 #'Ctrl' |
1072 #'Ctrl' |
1016 ). |
1073 ). |
1017 ]. |
1074 ]. |
1018 |
1075 |
1019 m := PopUpMenu |
1076 m := PopUpMenu |
1020 labels:(resources array:labels) |
1077 labels:(resources array:labels) |
1021 selectors:selectors |
1078 selectors:selectors |
1022 accelerators:shorties. |
1079 accelerators:shorties. |
1023 |
1080 |
1024 m subMenuAt:#otherMenu put:specialMenu. |
1081 m subMenuAt:#otherMenu put:specialMenu. |
1025 ^ m |
1082 ^ m |
1026 |
1083 |
1027 "Created: 14.9.1995 / 10:50:17 / claus" |
1084 "Created: 14.9.1995 / 10:50:17 / claus" |
1028 "Modified: 11.1.1997 / 21:38:33 / cg" |
1085 "Modified: 11.10.1997 / 16:43:54 / cg" |
1029 ! |
1086 ! |
1030 |
1087 |
1031 classCategoryNewCategory |
1088 classCategoryNewCategory |
1032 |box| |
1089 |box| |
1033 |
1090 |
1835 Extract documentation either from a documentation method or |
1892 Extract documentation either from a documentation method or |
1836 from the comment - not a biggy, but beginners will like |
1893 from the comment - not a biggy, but beginners will like |
1837 it when exploring the system." |
1894 it when exploring the system." |
1838 |
1895 |
1839 self doClassMenu:[:currentClass | |
1896 self doClassMenu:[:currentClass | |
1840 |m s aStream isComment| |
1897 |m s aStream isComment| |
1841 |
1898 |
1842 aStream := TextStream on:(String new:200). |
1899 aStream := TextStream on:(String new:200). |
1843 |
1900 |
1844 "/ |
1901 "/ |
1845 "/ here, show it with a nameSpace pragma |
1902 "/ here, show it with a nameSpace pragma |
1846 "/ and prefer short names. |
1903 "/ and prefer short names. |
1847 "/ |
1904 "/ |
1848 currentClass |
1905 currentClass |
1849 basicFileOutDefinitionOn:aStream |
1906 basicFileOutDefinitionOn:aStream |
1850 withNameSpace:true. |
1907 withNameSpace:true. |
1851 |
1908 |
1852 currentClass isLoaded ifTrue:[ |
1909 currentClass isLoaded ifTrue:[ |
1853 " |
1910 " |
1854 add documentation as a comment, if there is any |
1911 add documentation as a comment, if there is any |
1855 " |
1912 " |
1856 m := currentClass class compiledMethodAt:#documentation. |
1913 m := currentClass class compiledMethodAt:#documentation. |
1857 m notNil ifTrue:[ |
1914 m notNil ifTrue:[ |
1858 s := m comment. |
1915 s := m comment. |
1859 isComment := false. |
1916 isComment := false. |
1860 ] ifFalse:[ |
1917 ] ifFalse:[ |
1861 "try comment" |
1918 "try comment" |
1862 s := currentClass comment. |
1919 s := currentClass comment. |
1863 s notNil ifTrue:[ |
1920 s isString ifTrue:[ |
1864 s isEmpty ifTrue:[ |
1921 s isEmpty ifTrue:[ |
1865 s := nil |
1922 s := nil |
1866 ] ifFalse:[ |
1923 ] ifFalse:[ |
1867 (s includes:$") ifTrue:[ |
1924 (s includes:$") ifTrue:[ |
1868 s := s copy replaceAll:$" with:$'. |
1925 s := s copy replaceAll:$" with:$'. |
1869 ]. |
1926 ]. |
1870 isComment := true |
1927 isComment := true |
1871 ] |
1928 ] |
1872 ] |
1929 ] ifFalse:[ |
1873 ]. |
1930 "/ class redefines comment ? |
1874 ]. |
1931 s := nil |
1875 aStream cr; cr; cr; cr; cr. |
1932 ] |
1876 aStream emphasis:(#color -> (Color red:0 green:0 blue:25)). |
1933 ]. |
1877 s isNil ifTrue:[ |
1934 ]. |
1878 aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation found'. |
1935 aStream cr; cr; cr; cr; cr. |
1879 ] ifFalse:[ |
1936 aStream emphasis:(#color -> (Color red:0 green:0 blue:25)). |
1880 aStream nextPut:$" ; cr; nextPutLine:' Documentation:'. |
1937 s isNil ifTrue:[ |
1881 aStream cr; nextPutLine:s; cr. |
1938 aStream nextPut:$" ; cr; nextPutLine:' no comment or documentation found'. |
1882 aStream nextPutLine:' Notice: '. |
1939 ] ifFalse:[ |
1883 aStream nextPutAll:' the above string has been extracted from the classes '. |
1940 aStream nextPut:$" ; cr; nextPutLine:' Documentation:'. |
1884 aStream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']). |
1941 aStream cr; nextPutLine:s; cr. |
1885 aStream nextPutLine:' It will not be preserved when accepting a new class definition.'. |
1942 aStream nextPutLine:' Notice: '. |
1886 ]. |
1943 aStream nextPutAll:' the above string has been extracted from the classes '. |
1887 aStream nextPut:$". |
1944 aStream nextPutLine:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']). |
1888 aStream emphasis:nil. |
1945 aStream nextPutLine:' It will not be preserved when accepting a new class definition.'. |
1889 |
1946 ]. |
1890 codeView contents:(aStream contents). |
1947 aStream nextPut:$". |
1891 codeView modified:false. |
1948 aStream emphasis:nil. |
1892 codeView acceptAction:[:theCode | |
1949 |
1893 |ns| |
1950 codeView contents:(aStream contents). |
1894 |
1951 codeView modified:false. |
1895 currentClass notNil ifTrue:[ |
1952 codeView acceptAction:[:theCode | |
1896 ns := currentClass nameSpace |
1953 |ns| |
1897 ] ifFalse:[ |
1954 |
1898 ns := nil |
1955 currentClass notNil ifTrue:[ |
1899 ]. |
1956 ns := currentClass nameSpace |
|
1957 ] ifFalse:[ |
|
1958 ns := nil |
|
1959 ]. |
1900 |
1960 |
1901 codeView cursor:Cursor execute. |
1961 codeView cursor:Cursor execute. |
1902 |
1962 |
1903 Class nameSpaceQuerySignal handle:[:ex | |
1963 Class nameSpaceQuerySignal handle:[:ex | |
1904 ns isNil ifTrue:[ |
1964 ns isNil ifTrue:[ |
1905 ex reject |
1965 ex reject |
1906 ]. |
1966 ]. |
1907 ex proceedWith:ns |
1967 ex proceedWith:ns |
1908 ] do:[ |
1968 ] do:[ |
1909 Object abortSignal catch:[ |
1969 Object abortSignal catch:[ |
1910 |
1970 |
1911 Class nameSpaceQuerySignal answer:Smalltalk |
1971 Class nameSpaceQuerySignal answer:Smalltalk |
1912 do:[ |
1972 do:[ |
1913 (Compiler evaluate:theCode asString notifying:codeView compile:false) |
1973 (Compiler evaluate:theCode asString notifying:codeView compile:false) |
1914 isBehavior ifTrue:[ |
1974 isBehavior ifTrue:[ |
1915 codeView modified:false. |
1975 codeView modified:false. |
1916 self classCategoryUpdate. |
1976 self classCategoryUpdate. |
1917 self updateClassListWithScroll:false. |
1977 self updateClassListWithScroll:false. |
1918 ] |
1978 ] |
1919 ] |
1979 ] |
1920 ]. |
1980 ]. |
1921 ]. |
1981 ]. |
1922 codeView cursor:Cursor normal. |
1982 codeView cursor:Cursor normal. |
1923 ]. |
1983 ]. |
1924 codeView explainAction:nil. |
1984 codeView explainAction:nil. |
1925 |
1985 |
1926 methodListView notNil ifTrue:[ |
1986 methodListView notNil ifTrue:[ |
1927 methodListView setSelection:nil |
1987 methodListView setSelection:nil |
1928 ]. |
1988 ]. |
1929 aspect := #definition. |
1989 aspect := #definition. |
1930 self normalLabel |
1990 self normalLabel |
1931 ] |
1991 ] |
1932 |
1992 |
1933 "Modified: 1.8.1997 / 11:54:10 / cg" |
1993 "Modified: 11.10.1997 / 16:25:42 / cg" |
1934 ! |
1994 ! |
1935 |
1995 |
1936 classDocumentation |
1996 classDocumentation |
1937 "show classes documentation (i.e. open doc-View on it)" |
1997 "show classes documentation (i.e. open doc-View on it)" |
1938 |
1998 |