10 hereby transferred. |
10 hereby transferred. |
11 " |
11 " |
12 |
12 |
13 ClassDescription subclass:#Class |
13 ClassDescription subclass:#Class |
14 instanceVariableNames:'classvars comment subclasses classFilename package history' |
14 instanceVariableNames:'classvars comment subclasses classFilename package history' |
15 classVariableNames:'UpdatingChanges FileOutErrorSignal' |
15 classVariableNames:'UpdatingChanges FileOutErrorSignal |
|
16 CatchMethodRedefinitions MethodRedefinitionSignal' |
16 poolDictionaries:'' |
17 poolDictionaries:'' |
17 category:'Kernel-Classes' |
18 category:'Kernel-Classes' |
18 ! |
19 ! |
19 |
20 |
20 Class comment:' |
21 Class comment:' |
21 COPYRIGHT (c) 1989 by Claus Gittinger |
22 COPYRIGHT (c) 1989 by Claus Gittinger |
22 All Rights Reserved |
23 All Rights Reserved |
23 |
24 |
24 $Header: /cvs/stx/stx/libbasic/Class.st,v 1.47 1995-07-02 01:06:03 claus Exp $ |
25 $Header: /cvs/stx/stx/libbasic/Class.st,v 1.48 1995-07-22 19:21:42 claus Exp $ |
25 '! |
26 '! |
26 |
27 |
27 !Class class methodsFor:'documentation'! |
28 !Class class methodsFor:'documentation'! |
28 |
29 |
29 copyright |
30 copyright |
81 UpdatingChanges <Boolean> true if the changes-file shall be updated |
82 UpdatingChanges <Boolean> true if the changes-file shall be updated |
82 (except during startup and when filing in, this flag |
83 (except during startup and when filing in, this flag |
83 is usually true) |
84 is usually true) |
84 |
85 |
85 FileOutErrorSignal raised when an error occurs during fileOut |
86 FileOutErrorSignal raised when an error occurs during fileOut |
|
87 |
|
88 CatchMethodRedefinitions if true, classes protect themself |
|
89 MethodRedefinitionSignal (by raising MethodRedefinitionSignal) |
|
90 from redefining any existing methods, |
|
91 which are defined in another package. |
|
92 (i.e. a signal will be raised, if you |
|
93 fileIn something which redefines an |
|
94 existing method and the packages do not |
|
95 match). |
|
96 The default is (currently) true. |
86 |
97 |
87 WARNING: layout known by compiler and runtime system |
98 WARNING: layout known by compiler and runtime system |
88 " |
99 " |
89 ! ! |
100 ! ! |
90 |
101 |
95 into the changes-file; normally this variable is set to true, but |
106 into the changes-file; normally this variable is set to true, but |
96 (for example) during fileIn or when changes are applied, it is set to false |
107 (for example) during fileIn or when changes are applied, it is set to false |
97 to avoid putting too much junk into the changes-file." |
108 to avoid putting too much junk into the changes-file." |
98 |
109 |
99 UpdatingChanges := true. |
110 UpdatingChanges := true. |
|
111 CatchMethodRedefinitions := true. |
|
112 |
100 FileOutErrorSignal isNil ifTrue:[ |
113 FileOutErrorSignal isNil ifTrue:[ |
101 FileOutErrorSignal := Object errorSignal newSignalMayProceed:false. |
114 FileOutErrorSignal := Object errorSignal newSignalMayProceed:false. |
102 FileOutErrorSignal nameClass:self message:#fileOutErrorSignal. |
115 FileOutErrorSignal nameClass:self message:#fileOutErrorSignal. |
103 FileOutErrorSignal notifierString:'error during fileOut'. |
116 FileOutErrorSignal notifierString:'error during fileOut'. |
|
117 |
|
118 MethodRedefinitionSignal := Object errorSignal newSignalMayProceed:true. |
|
119 MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal. |
|
120 MethodRedefinitionSignal notifierString:'attempt to redefine method from different package'. |
104 ] |
121 ] |
105 ! ! |
122 ! ! |
106 |
123 |
107 !Class class methodsFor:'Signal constants'! |
124 !Class class methodsFor:'Signal constants'! |
108 |
125 |
110 "return the signal raised when an error occurs while fileing out. |
127 "return the signal raised when an error occurs while fileing out. |
111 This is signalled to allow browsers some user feed back in case |
128 This is signalled to allow browsers some user feed back in case |
112 a fileout fails (for example due to disk-full errors)" |
129 a fileout fails (for example due to disk-full errors)" |
113 |
130 |
114 ^ FileOutErrorSignal |
131 ^ FileOutErrorSignal |
|
132 ! |
|
133 |
|
134 methodRedefinitionSignal |
|
135 "return the signal raised when a method is about to be installed |
|
136 which redefines an existing method and the methods packages are not |
|
137 equal. This helps when filing in alien code, to prevent existing |
|
138 methods to be overwritten or redefined by incompatible methods" |
|
139 |
|
140 ^ MethodRedefinitionSignal |
|
141 ! ! |
|
142 |
|
143 !Class class methodsFor:'accessing - flags'! |
|
144 |
|
145 updateChanges:aBoolean |
|
146 "turn on/off changes management. Return the prior value of the flag." |
|
147 |
|
148 |prev| |
|
149 |
|
150 prev := UpdatingChanges. |
|
151 UpdatingChanges := aBoolean. |
|
152 ^ prev |
|
153 ! |
|
154 |
|
155 updatingChanges |
|
156 "return true if changes are recorded" |
|
157 |
|
158 ^ UpdatingChanges |
|
159 ! |
|
160 |
|
161 catchMethodRedefinitions |
|
162 "return the redefinition catching flag." |
|
163 |
|
164 ^ CatchMethodRedefinitions |
|
165 ! |
|
166 |
|
167 catchMethodRedefinitions:aBoolean |
|
168 "turn on/off redefinition catching. Return the prior value of the flag." |
|
169 |
|
170 |prev| |
|
171 |
|
172 prev := CatchMethodRedefinitions. |
|
173 CatchMethodRedefinitions := aBoolean. |
|
174 ^ prev |
115 ! ! |
175 ! ! |
116 |
176 |
117 !Class class methodsFor:'enumeration '! |
177 !Class class methodsFor:'enumeration '! |
118 |
178 |
119 allClassesInCategory:aCategory do:aBlock |
179 allClassesInCategory:aCategory do:aBlock |
807 addSelector:newSelector withMethod:newMethod |
867 addSelector:newSelector withMethod:newMethod |
808 "add the method given by 2nd argument under the selector given by |
868 "add the method given by 2nd argument under the selector given by |
809 1st argument to the methodDictionary. |
869 1st argument to the methodDictionary. |
810 Append a change record to the changes file and tell dependents." |
870 Append a change record to the changes file and tell dependents." |
811 |
871 |
|
872 |oldMethod| |
|
873 |
|
874 CatchMethodRedefinitions ifTrue:[ |
|
875 "check for attempts to redefine a method |
|
876 in a different package. Signal a resumable error if so. |
|
877 This allows tracing redefinitions of existing system methods |
|
878 when filing in alien code .... |
|
879 (which we may want to forbit sometimes) |
|
880 " |
|
881 oldMethod := self compiledMethodAt:newSelector. |
|
882 oldMethod notNil ifTrue:[ |
|
883 oldMethod package ~= newMethod package ifTrue:[ |
|
884 " |
|
885 attempt to redefine an existing method, which was |
|
886 defined in another package. |
|
887 If you continue in the debugger, the new method gets installed. |
|
888 Otherwise, the existing (old) method remains valid. |
|
889 |
|
890 You can turn of the catching of redefinitions by setting |
|
891 CatchMethodRedefinitions to false |
|
892 (also found in the NewLaunchers 'settings-misc' menu) |
|
893 " |
|
894 MethodRedefinitionSignal raise |
|
895 ] |
|
896 ] |
|
897 ]. |
812 (super addSelector:newSelector withMethod:newMethod) ifTrue:[ |
898 (super addSelector:newSelector withMethod:newMethod) ifTrue:[ |
813 self addChangeRecordForMethod:newMethod |
899 self addChangeRecordForMethod:newMethod |
814 ] |
900 ] |
815 ! |
901 ! |
816 |
902 |
880 prev := UpdatingChanges. |
966 prev := UpdatingChanges. |
881 UpdatingChanges := false. |
967 UpdatingChanges := false. |
882 aBlock valueNowOrOnUnwindDo:[ |
968 aBlock valueNowOrOnUnwindDo:[ |
883 prev ifTrue:[UpdatingChanges := true] |
969 prev ifTrue:[UpdatingChanges := true] |
884 ]. |
970 ]. |
885 ! |
|
886 |
|
887 updateChanges:aBoolean |
|
888 "turn on/off changes management. Return the prior value of the flag." |
|
889 |
|
890 |prev| |
|
891 |
|
892 prev := UpdatingChanges. |
|
893 UpdatingChanges := aBoolean. |
|
894 ^ prev |
|
895 ! |
|
896 |
|
897 updatingChanges |
|
898 "return true if changes are recorded" |
|
899 |
|
900 ^ UpdatingChanges |
|
901 ! |
971 ! |
902 |
972 |
903 changesStream |
973 changesStream |
904 "return a Stream for the changes file - or nil if no update is wanted" |
974 "return a Stream for the changes file - or nil if no update is wanted" |
905 |
975 |
1284 subclasses" |
1354 subclasses" |
1285 |
1355 |
1286 |cat code| |
1356 |cat code| |
1287 |
1357 |
1288 Class withoutUpdatingChangesDo:[ |
1358 Class withoutUpdatingChangesDo:[ |
1289 cat := (self compiledMethodAt:aSelector) category. |
1359 Class methodRedefinitionSignal handle:[:ex | |
1290 code := self sourceCodeAt:aSelector. |
1360 ex proceed |
1291 self compilerClass compile:code forClass:self inCategory:cat |
1361 ] do:[ |
|
1362 cat := (self compiledMethodAt:aSelector) category. |
|
1363 code := self sourceCodeAt:aSelector. |
|
1364 self compilerClass compile:code forClass:self inCategory:cat |
|
1365 ] |
1292 ] |
1366 ] |
1293 ! |
1367 ! |
1294 |
1368 |
1295 recompile |
1369 recompile |
1296 "recompile all methods |
1370 "recompile all methods |
1637 (comment := self comment) isNil ifTrue:[ |
1711 (comment := self comment) isNil ifTrue:[ |
1638 s := '''''' |
1712 s := '''''' |
1639 ] ifFalse:[ |
1713 ] ifFalse:[ |
1640 s := comment storeString |
1714 s := comment storeString |
1641 ]. |
1715 ]. |
1642 aStream nextPutAll:s |
1716 aStream nextPutAll:s. |
1643 aStream cr |
1717 aStream cr |
1644 ! |
1718 ! |
1645 |
1719 |
1646 fileOutDefinitionOn:aStream |
1720 fileOutDefinitionOn:aStream |
1647 "append an expression on aStream, which defines myself." |
1721 "append an expression on aStream, which defines myself." |
1793 ! |
1867 ! |
1794 |
1868 |
1795 fileOutCategory:aCategory on:aStream |
1869 fileOutCategory:aCategory on:aStream |
1796 "file out all methods belonging to aCategory, aString onto aStream" |
1870 "file out all methods belonging to aCategory, aString onto aStream" |
1797 |
1871 |
1798 |nMethods count sep source| |
1872 |nMethods count sep source sortedSelectors sortedMethods| |
1799 |
1873 |
1800 methodArray notNil ifTrue:[ |
1874 methodArray notNil ifTrue:[ |
1801 nMethods := 0. |
1875 nMethods := 0. |
1802 methodArray do:[:aMethod | |
1876 methodArray do:[:aMethod | |
1803 (aCategory = aMethod category) ifTrue:[ |
1877 (aCategory = aMethod category) ifTrue:[ |
1812 aCategory notNil ifTrue:[ |
1886 aCategory notNil ifTrue:[ |
1813 aStream nextPutAll:aCategory |
1887 aStream nextPutAll:aCategory |
1814 ]. |
1888 ]. |
1815 aStream nextPut:$'; nextPut:sep; cr; cr. |
1889 aStream nextPut:$'; nextPut:sep; cr; cr. |
1816 count := 1. |
1890 count := 1. |
|
1891 |
|
1892 "/ |
|
1893 "/ sort by selector |
|
1894 "/ |
|
1895 sortedSelectors := selectorArray copy. |
|
1896 sortedMethods := methodArray copy. |
|
1897 sortedSelectors sortWith:sortedMethods. |
|
1898 |
1817 methodArray do:[:aMethod | |
1899 methodArray do:[:aMethod | |
1818 (aCategory = aMethod category) ifTrue:[ |
1900 (aCategory = aMethod category) ifTrue:[ |
1819 source := aMethod source. |
1901 source := aMethod source. |
1820 source isNil ifTrue:[ |
1902 source isNil ifTrue:[ |
1821 FileOutErrorSignal raiseRequestWith:'no source for method' |
1903 FileOutErrorSignal raiseRequestWith:'no source for method' |
1822 ] ifFalse:[ |
1904 ] ifFalse:[ |
1823 aStream nextChunkPut:(aMethod source). |
1905 aStream nextChunkPut:source. |
1824 ]. |
1906 ]. |
1825 (count ~~ nMethods) ifTrue:[ |
1907 (count ~~ nMethods) ifTrue:[ |
1826 aStream cr; cr |
1908 aStream cr; cr |
1827 ]. |
1909 ]. |
1828 count := count + 1 |
1910 count := count + 1 |
1856 raiseRequestWith:self |
1938 raiseRequestWith:self |
1857 errorString:('no source for method: ' , |
1939 errorString:('no source for method: ' , |
1858 self name , '>>' , |
1940 self name , '>>' , |
1859 (self selectorAtMethod:aMethod)) |
1941 (self selectorAtMethod:aMethod)) |
1860 ] ifFalse:[ |
1942 ] ifFalse:[ |
1861 aStream nextChunkPut:(aMethod source). |
1943 aStream nextChunkPut:source. |
1862 ]. |
1944 ]. |
1863 aStream space. |
1945 aStream space. |
1864 aStream nextPut:sep. |
1946 aStream nextPut:sep. |
1865 aStream cr |
1947 aStream cr |
1866 ] |
1948 ] |
1937 self fileOutPrimitiveSpecsOn:aStream. |
2019 self fileOutPrimitiveSpecsOn:aStream. |
1938 |
2020 |
1939 " |
2021 " |
1940 methods from all categories in metaclass |
2022 methods from all categories in metaclass |
1941 " |
2023 " |
1942 collectionOfCategories := self class categories. |
2024 collectionOfCategories := self class categories asSortedCollection. |
1943 collectionOfCategories notNil ifTrue:[ |
2025 collectionOfCategories notNil ifTrue:[ |
1944 " |
2026 " |
1945 documentation first (if any) |
2027 documentation first (if any) |
1946 " |
2028 " |
1947 (collectionOfCategories includes:'documentation') ifTrue:[ |
2029 (collectionOfCategories includes:'documentation') ifTrue:[ |
1972 ] |
2054 ] |
1973 ]. |
2055 ]. |
1974 " |
2056 " |
1975 methods from all categories in myself |
2057 methods from all categories in myself |
1976 " |
2058 " |
1977 collectionOfCategories := self categories. |
2059 collectionOfCategories := self categories asSortedCollection. |
1978 collectionOfCategories notNil ifTrue:[ |
2060 collectionOfCategories notNil ifTrue:[ |
1979 collectionOfCategories do:[:aCategory | |
2061 collectionOfCategories do:[:aCategory | |
1980 self fileOutCategory:aCategory on:aStream. |
2062 self fileOutCategory:aCategory on:aStream. |
1981 aStream cr |
2063 aStream cr |
1982 ] |
2064 ] |