964 |
964 |
965 changeFileSize := f info at:#size. |
965 changeFileSize := f info at:#size. |
966 changeFileTimestamp := f info at:#modified. |
966 changeFileTimestamp := f info at:#modified. |
967 |
967 |
968 self withCursor:(Cursor read) do:[ |
968 self withCursor:(Cursor read) do:[ |
969 |myProcess myPriority| |
969 |myProcess myPriority| |
970 |
970 |
971 " |
971 " |
972 this is a time consuming operation (especially, if reading an |
972 this is a time consuming operation (especially, if reading an |
973 NFS-mounted directory; therefore lower my priority ... |
973 NFS-mounted directory; therefore lower my priority ... |
974 " |
974 " |
975 inBackground ifTrue:[ |
975 inBackground ifTrue:[ |
976 myProcess := Processor activeProcess. |
976 myProcess := Processor activeProcess. |
977 myPriority := myProcess priority. |
977 myPriority := myProcess priority. |
978 myProcess priority:(Processor userBackgroundPriority). |
978 myProcess priority:(Processor userBackgroundPriority). |
979 ]. |
979 ]. |
980 |
980 |
981 [ |
981 [ |
982 |excla timeStampInfo| |
982 |excla timeStampInfo| |
983 |
983 |
984 changeChunks := OrderedCollection new. |
984 changeChunks := OrderedCollection new. |
985 changeHeaderLines := OrderedCollection new. |
985 changeHeaderLines := OrderedCollection new. |
986 changePositions := OrderedCollection new. |
986 changePositions := OrderedCollection new. |
987 changeTimeStamps := OrderedCollection new. |
987 changeTimeStamps := OrderedCollection new. |
988 excla := aStream class chunkSeparator. |
988 excla := aStream class chunkSeparator. |
989 |
989 |
990 [aStream atEnd] whileFalse:[ |
990 [aStream atEnd] whileFalse:[ |
991 |entry changeDelta changeString changeType |
991 |entry changeDelta changeString changeType |
992 line s l changeClass sawExcla category |
992 line s l changeClass sawExcla category |
993 chunkText chunkPos sel| |
993 chunkText chunkPos sel| |
994 |
994 |
995 " |
995 " |
996 get a chunk (separated by excla) |
996 get a chunk (separated by excla) |
997 " |
997 " |
998 aStream skipSeparators. |
998 aStream skipSeparators. |
999 chunkPos := aStream position. |
999 chunkPos := aStream position. |
1000 |
1000 |
1001 |
1001 |
1002 sawExcla := aStream peekFor:excla. |
1002 sawExcla := aStream peekFor:excla. |
1003 chunkText := aStream nextChunk. |
1003 chunkText := aStream nextChunk. |
1004 chunkText notNil ifTrue:[ |
1004 chunkText notNil ifTrue:[ |
1005 |index headerLine| |
1005 |index headerLine cls| |
1006 |
1006 |
1007 (chunkText startsWith:'''---- timestamp ') ifTrue:[ |
1007 (chunkText startsWith:'''---- timestamp ') ifTrue:[ |
1008 timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces. |
1008 timeStampInfo := (chunkText copyFrom:16 to:(chunkText size - 6)) withoutSpaces. |
1009 ] ifFalse:[ |
1009 ] ifFalse:[ |
1010 |
1010 |
1011 " |
1011 " |
1012 only first line is saved in changeChunks ... |
1012 only first line is saved in changeChunks ... |
1013 " |
1013 " |
1014 index := chunkText indexOf:(Character cr). |
1014 index := chunkText indexOf:(Character cr). |
1015 (index ~~ 0) ifTrue:[ |
1015 (index ~~ 0) ifTrue:[ |
1016 chunkText := chunkText copyTo:(index - 1). |
1016 chunkText := chunkText copyTo:(index - 1). |
1017 |
1017 |
1018 "take care for comment changes - must still be a |
1018 "take care for comment changes - must still be a |
1019 valid expression for classNameOfChange: to work" |
1019 valid expression for classNameOfChange: to work" |
1020 |
1020 |
1021 (chunkText endsWith:'comment:''') ifTrue:[ |
1021 (chunkText endsWith:'comment:''') ifTrue:[ |
1022 chunkText := chunkText , '...''' |
1022 chunkText := chunkText , '...''' |
1023 ]. |
1023 ]. |
1024 (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[ |
1024 (chunkText endsWith:'primitiveDefinitions:''') ifTrue:[ |
1025 sel := 'primitiveDefinitions:'. |
1025 sel := 'primitiveDefinitions:'. |
1026 chunkText := chunkText copyWithoutLast:1 |
1026 chunkText := chunkText copyWithoutLast:1 |
1027 ]. |
1027 ]. |
1028 (chunkText endsWith:'primitiveVariables:''') ifTrue:[ |
1028 (chunkText endsWith:'primitiveVariables:''') ifTrue:[ |
1029 sel := 'primitiveVariables:'. |
1029 sel := 'primitiveVariables:'. |
1030 chunkText := chunkText copyWithoutLast:1 |
1030 chunkText := chunkText copyWithoutLast:1 |
1031 ]. |
1031 ]. |
1032 (chunkText endsWith:'primitiveFunctions:''') ifTrue:[ |
1032 (chunkText endsWith:'primitiveFunctions:''') ifTrue:[ |
1033 sel := 'primitiveFunctions:'. |
1033 sel := 'primitiveFunctions:'. |
1034 chunkText := chunkText copyWithoutLast:1 |
1034 chunkText := chunkText copyWithoutLast:1 |
1035 ]. |
1035 ]. |
1036 ]. |
1036 ]. |
1037 |
1037 |
1038 changeChunks add:chunkText. |
1038 changeChunks add:chunkText. |
1039 changePositions add:chunkPos. |
1039 changePositions add:chunkPos. |
1040 changeTimeStamps add:timeStampInfo. |
1040 changeTimeStamps add:timeStampInfo. |
1041 |
1041 |
1042 headerLine := nil. |
1042 headerLine := nil. |
1043 changeDelta := ' '. |
1043 changeDelta := ' '. |
1044 |
1044 |
1045 sawExcla ifFalse:[ |
1045 sawExcla ifFalse:[ |
1046 (chunkText startsWith:'''---- snap') ifTrue:[ |
1046 (chunkText startsWith:'''---- snap') ifTrue:[ |
1047 changeType := ''. |
1047 changeType := ''. |
1048 headerLine := chunkText. |
1048 headerLine := chunkText. |
1049 changeString := (chunkText contractTo:maxLen). |
1049 changeString := (chunkText contractTo:maxLen). |
1050 ] ifFalse:[ |
1050 ] ifFalse:[ |
1051 |
1051 |
1052 |p cls| |
1052 |p cls| |
1053 |
1053 |
1054 headerLine := chunkText , ' (doIt)'. |
1054 headerLine := chunkText , ' (doIt)'. |
1055 |
1055 |
1056 " |
1056 " |
1057 first, assume doIt - then lets have a more detailed look ... |
1057 first, assume doIt - then lets have a more detailed look ... |
1058 " |
1058 " |
1059 (chunkText startsWith:'''---- file') ifTrue:[ |
1059 (chunkText startsWith:'''---- file') ifTrue:[ |
1060 changeType := ''. |
1060 changeType := ''. |
1061 ] ifFalse:[ |
1061 ] ifFalse:[ |
1062 changeType := '(doIt)'. |
1062 changeType := '(doIt)'. |
1063 ]. |
1063 ]. |
1064 changeString := (chunkText contractTo:maxLen). |
1064 changeString := (chunkText contractTo:maxLen). |
1065 |
1065 |
1066 p := Parser parseExpression:chunkText. |
1066 p := Parser parseExpression:chunkText. |
1067 (p notNil |
1067 (p notNil |
1068 and:[p ~~ #Error |
1068 and:[p ~~ #Error |
1069 and:[p isMessage]]) ifTrue:[ |
1069 and:[p isMessage]]) ifTrue:[ |
1070 sel := p selector. |
1070 sel := p selector. |
1071 ]. |
1071 ]. |
1072 (sel == #removeSelector:) ifTrue:[ |
1072 (sel == #removeSelector:) ifTrue:[ |
1073 p receiver isUnaryMessage ifTrue:[ |
1073 p receiver isUnaryMessage ifTrue:[ |
1074 cls := p receiver receiver name. |
1074 cls := p receiver receiver name. |
1075 changeClass := (Smalltalk classNamed:cls) class. |
1075 changeClass := (Smalltalk classNamed:cls) class. |
1076 cls := cls , ' class'. |
1076 cls := cls , ' class'. |
1077 ] ifFalse:[ |
1077 ] ifFalse:[ |
1078 cls := p receiver name. |
1078 cls := p receiver name. |
1079 changeClass := (Smalltalk classNamed:cls) |
1079 changeClass := (Smalltalk classNamed:cls) |
1080 ]. |
1080 ]. |
1081 sel := (p args at:1) evaluate. |
1081 sel := (p args at:1) evaluate. |
1082 |
1082 |
1083 compareChanges ifTrue:[ |
1083 compareChanges ifTrue:[ |
1084 (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ |
1084 (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ |
1085 changeDelta := '?' |
1085 changeDelta := '?' |
1086 ] ifFalse:[ |
1086 ] ifFalse:[ |
1087 (changeClass implements:sel asSymbol) ifTrue:[ |
1087 (changeClass implements:sel asSymbol) ifTrue:[ |
1088 changeDelta := '-'. |
1088 changeDelta := '-'. |
1089 ] |
1089 ] |
1090 ] |
1090 ] |
1091 ]. |
1091 ]. |
1092 changeType := '(remove)'. |
1092 changeType := '(remove)'. |
1093 changeString := self contractClass:cls selector:sel to:maxLen. |
1093 changeString := self contractClass:cls selector:sel to:maxLen. |
1094 ]. |
1094 ]. |
1095 (p ~~ #Error |
1095 (p ~~ #Error |
1096 and:[p isMessage |
1096 and:[p isMessage |
1097 and:[p receiver isMessage |
1097 and:[p receiver isMessage |
1098 and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[ |
1098 and:[p receiver selector == #compiledMethodAt:]]]) ifTrue:[ |
1099 p receiver receiver isUnaryMessage ifTrue:[ |
1099 p receiver receiver isUnaryMessage ifTrue:[ |
1100 cls := p receiver receiver receiver name. |
1100 cls := p receiver receiver receiver name. |
1101 changeClass := (Smalltalk classNamed:cls) class. |
1101 changeClass := (Smalltalk classNamed:cls) class. |
1102 cls := cls , ' class'. |
1102 cls := cls , ' class'. |
1103 ] ifFalse:[ |
1103 ] ifFalse:[ |
1104 cls := p receiver receiver name. |
1104 cls := p receiver receiver name. |
1105 changeClass := (Smalltalk classNamed:cls) |
1105 changeClass := (Smalltalk classNamed:cls) |
1106 ]. |
1106 ]. |
1107 (sel == #category:) ifTrue:[ |
1107 (sel == #category:) ifTrue:[ |
1108 sel := (p receiver args at:1) evaluate. |
1108 sel := (p receiver args at:1) evaluate. |
1109 changeType := '(category change)'. |
1109 changeType := '(category change)'. |
1110 changeString := self contractClass:cls selector:sel to:maxLen. |
1110 changeString := self contractClass:cls selector:sel to:maxLen. |
1111 ]. |
1111 ]. |
1112 (sel == #privacy:) ifTrue:[ |
1112 (sel == #privacy:) ifTrue:[ |
1113 sel := (p receiver args at:1) evaluate. |
1113 sel := (p receiver args at:1) evaluate. |
1114 changeType := '(privacy change)'. |
1114 changeType := '(privacy change)'. |
1115 changeString := self contractClass:cls selector:sel to:maxLen. |
1115 changeString := self contractClass:cls selector:sel to:maxLen. |
1116 ]. |
1116 ]. |
1117 ]. |
1117 ]. |
1118 (#(#'subclass:' |
1118 (#(#'subclass:' |
1119 #'variableSubclass:' |
1119 #'variableSubclass:' |
1120 #'variableByteSubclass:' |
1120 #'variableByteSubclass:' |
1121 #'variableWordSubclass:' |
1121 #'variableWordSubclass:' |
1122 #'variableLongSubclass:' |
1122 #'variableLongSubclass:' |
1123 #'variableFloatSubclass:' |
1123 #'variableFloatSubclass:' |
1124 #'variableDoubleSubclass:' |
1124 #'variableDoubleSubclass:' |
1125 #'primitiveDefinitions:' |
1125 #'primitiveDefinitions:' |
1126 #'primitiveFunctions:' |
1126 #'primitiveFunctions:' |
1127 #'primitiveVariables:' |
1127 #'primitiveVariables:' |
1128 ) includes:sel) ifTrue:[ |
1128 ) includes:sel) ifTrue:[ |
1129 changeType := '(class definition)'. |
1129 changeType := '(class definition)'. |
1130 ]. |
1130 ]. |
1131 ] |
1131 ] |
1132 ] ifTrue:[ "sawExcla" |
1132 ] ifTrue:[ "sawExcla" |
1133 |done first p cls text| |
1133 |done first p cls text| |
1134 |
1134 |
1135 " |
1135 " |
1136 method definitions actually consist of |
1136 method definitions actually consist of |
1137 two (or more) chunks; skip next chunk(s) |
1137 two (or more) chunks; skip next chunk(s) |
1138 up to an empty one. |
1138 up to an empty one. |
1139 The system only writes one chunk, |
1139 The system only writes one chunk, |
1140 and we cannot handle more in this ChangesBrowser .... |
1140 and we cannot handle more in this ChangesBrowser .... |
1141 " |
1141 " |
1142 cls := nil. |
1142 cls := nil. |
1143 p := Parser parseExpression:chunkText. |
1143 p := Parser parseExpression:chunkText. |
1144 |
1144 |
1145 (p notNil and:[p ~~ #Error]) ifTrue:[ |
1145 (p notNil and:[p ~~ #Error]) ifTrue:[ |
1146 sel := p selector. |
1146 sel := p selector. |
1147 (sel == #methodsFor:) ifTrue:[ |
1147 (sel == #methodsFor:) ifTrue:[ |
1148 p receiver isUnaryMessage ifTrue:[ |
1148 p receiver isUnaryMessage ifTrue:[ |
1149 cls := p receiver receiver name. |
1149 cls := p receiver receiver name. |
1150 changeClass := (Smalltalk classNamed:cls) class. |
1150 changeClass := (Smalltalk classNamed:cls) class. |
1151 cls := cls , ' class'. |
1151 cls := cls , ' class'. |
1152 ] ifFalse:[ |
1152 ] ifFalse:[ |
1153 cls := p receiver name. |
1153 cls := p receiver name. |
1154 changeClass := Smalltalk classNamed:cls |
1154 changeClass := Smalltalk classNamed:cls |
1155 ]. |
1155 ]. |
1156 category := (p args at:1) evaluate. |
1156 category := (p args at:1) evaluate. |
1157 ]. |
1157 ]. |
1158 ]. |
1158 ]. |
1159 done := false. |
1159 done := false. |
1160 first := true. |
1160 first := true. |
1161 [done] whileFalse:[ |
1161 [done] whileFalse:[ |
1162 text := aStream nextChunk. |
1162 text := aStream nextChunk. |
1163 text isNil ifTrue:[ |
1163 text isNil ifTrue:[ |
1164 done := true |
1164 done := true |
1165 ] ifFalse:[ |
1165 ] ifFalse:[ |
1166 done := text isEmpty |
1166 done := text isEmpty |
1167 ]. |
1167 ]. |
1168 done ifFalse:[ |
1168 done ifFalse:[ |
1169 first ifFalse:[ |
1169 first ifFalse:[ |
1170 Transcript showCr:'only one method per ''methodsFor:'' handled'. |
1170 Transcript showCr:'only one method per ''methodsFor:'' handled'. |
1171 ] ifTrue:[ |
1171 ] ifTrue:[ |
1172 first := false. |
1172 first := false. |
1173 " |
1173 " |
1174 try to find the selector |
1174 try to find the selector |
1175 " |
1175 " |
1176 sel := nil. |
1176 sel := nil. |
1177 cls notNil ifTrue:[ |
1177 cls notNil ifTrue:[ |
1178 p := Parser |
1178 p := Parser |
1179 parseMethodSpecification:text |
1179 parseMethodSpecification:text |
1180 in:nil |
1180 in:nil |
1181 ignoreErrors:true |
1181 ignoreErrors:true |
1182 ignoreWarnings:true. |
1182 ignoreWarnings:true. |
1183 (p notNil and:[p ~~ #Error]) ifTrue:[ |
1183 (p notNil and:[p ~~ #Error]) ifTrue:[ |
1184 sel := p selector. |
1184 sel := p selector. |
1185 ] |
1185 ] |
1186 ]. |
1186 ]. |
1187 |
1187 |
1188 sel isNil ifTrue:[ |
1188 sel isNil ifTrue:[ |
1189 changeString := (chunkText contractTo:maxLen). |
1189 changeString := (chunkText contractTo:maxLen). |
1190 changeType := '(change)'. |
1190 changeType := '(change)'. |
1191 ] ifFalse:[ |
1191 ] ifFalse:[ |
1192 changeString := self contractClass:cls selector:sel to:maxLen. |
1192 changeString := self contractClass:cls selector:sel to:maxLen. |
1193 changeType := '(method in: ''' , category , ''')'. |
1193 changeType := '(method in: ''' , category , ''')'. |
1194 ]. |
1194 ]. |
1195 sel isNil ifTrue:[ |
1195 sel isNil ifTrue:[ |
1196 headerLine := chunkText , ' (change)'. |
1196 headerLine := chunkText , ' (change)'. |
1197 ] ifFalse:[ |
1197 ] ifFalse:[ |
1198 headerLine := cls , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. |
1198 headerLine := cls , ' ' , sel , ' ' , '(change category: ''' , category , ''')'. |
1199 ]. |
1199 ]. |
1200 |
1200 |
1201 compareChanges ifTrue:[ |
1201 compareChanges ifTrue:[ |
1202 (changeClass isNil or:[changeClass isLoaded not]) ifTrue:[ |
1202 changeClass isNil ifFalse:[ |
1203 changeDelta := '?' |
1203 changeClass isMeta ifTrue:[ |
1204 ] ifFalse:[ |
1204 cls := changeClass soleInstance |
1205 (changeClass implements:sel asSymbol) ifFalse:[ |
1205 ] ifFalse:[ |
1206 changeDelta := '+'. |
1206 cls := changeClass |
1207 ] ifTrue:[ |
1207 ]. |
1208 |m currentText t1 t2| |
1208 ]. |
1209 |
1209 |
1210 m := changeClass compiledMethodAt:sel asSymbol. |
1210 (changeClass isNil or:[cls isLoaded not]) ifTrue:[ |
1211 currentText := m source. |
1211 changeDelta := '?' |
1212 currentText notNil ifTrue:[ |
1212 ] ifFalse:[ |
1213 text asString = currentText asString ifTrue:[ |
1213 (changeClass implements:sel asSymbol) ifFalse:[ |
1214 changeDelta := '=' |
1214 changeDelta := '+'. |
1215 ] ifFalse:[ |
1215 ] ifTrue:[ |
1216 t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded]. |
1216 |m currentText t1 t2| |
1217 t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded]. |
1217 |
1218 t1 = t2 ifTrue:[ |
1218 m := changeClass compiledMethodAt:sel asSymbol. |
1219 changeDelta := '=' |
1219 currentText := m source. |
1220 ] |
1220 currentText notNil ifTrue:[ |
1221 ] |
1221 text asString = currentText asString ifTrue:[ |
1222 ] |
1222 changeDelta := '=' |
1223 ] |
1223 ] ifFalse:[ |
1224 ] |
1224 t1 := currentText asCollectionOfLines collect:[:s | s withTabsExpanded]. |
1225 ] |
1225 t2 := text asCollectionOfLines collect:[:s | s withTabsExpanded]. |
1226 ] |
1226 t1 = t2 ifTrue:[ |
1227 ] |
1227 changeDelta := '=' |
1228 ] |
1228 ] |
1229 ]. |
1229 ] |
1230 changeString notNil ifTrue:[ |
1230 ] |
1231 entry := MultiColListEntry new. |
1231 ] |
1232 entry tabulatorSpecification:tabSpec. |
1232 ] |
1233 entry colAt:1 put:changeDelta. |
1233 ] |
1234 entry colAt:2 put:changeString. |
1234 ] |
1235 entry colAt:3 put:changeType. |
1235 ] |
1236 entry colAt:4 put:timeStampInfo. |
1236 ] |
1237 changeHeaderLines add:entry |
1237 ]. |
1238 ] ifFalse:[ |
1238 changeString notNil ifTrue:[ |
1239 headerLine notNil ifTrue:[ |
1239 entry := MultiColListEntry new. |
1240 changeHeaderLines add:headerLine |
1240 entry tabulatorSpecification:tabSpec. |
1241 ] |
1241 entry colAt:1 put:changeDelta. |
1242 ] |
1242 entry colAt:2 put:changeString. |
1243 ] |
1243 entry colAt:3 put:changeType. |
1244 ] |
1244 entry colAt:4 put:timeStampInfo. |
1245 ]. |
1245 changeHeaderLines add:entry |
1246 changeClassNames := OrderedCollection new grow:(changeChunks size). |
1246 ] ifFalse:[ |
1247 aStream close. |
1247 headerLine notNil ifTrue:[ |
1248 anyChanges := false |
1248 changeHeaderLines add:headerLine |
1249 ] valueNowOrOnUnwindDo:[ |
1249 ] |
1250 inBackground ifTrue:[myProcess priority:myPriority]. |
1250 ] |
1251 ]. |
1251 ] |
|
1252 ] |
|
1253 ]. |
|
1254 changeClassNames := OrderedCollection new grow:(changeChunks size). |
|
1255 aStream close. |
|
1256 anyChanges := false |
|
1257 ] valueNowOrOnUnwindDo:[ |
|
1258 inBackground ifTrue:[myProcess priority:myPriority]. |
|
1259 ]. |
1252 ]. |
1260 ]. |
1253 |
1261 |
1254 self checkIfFileHasChanged |
1262 self checkIfFileHasChanged |
1255 |
1263 |
1256 "Modified: 27.8.1995 / 23:06:55 / claus" |
1264 "Modified: 27.8.1995 / 23:06:55 / claus" |
1257 "Modified: 3.12.1995 / 18:52:34 / cg" |
1265 "Modified: 12.12.1995 / 14:34:03 / cg" |
1258 ! |
1266 ! |
1259 |
1267 |
1260 selectorOfMethodChange:changeNr |
1268 selectorOfMethodChange:changeNr |
1261 "return a changes selector" |
1269 "return a changes selector" |
1262 |
1270 |