2360 |
2360 |
2361 codeView contents:src. |
2361 codeView contents:src. |
2362 codeView modified:false. |
2362 codeView modified:false. |
2363 codeModified := false. |
2363 codeModified := false. |
2364 |
2364 |
2365 currentClass isNamespace ifTrue:[ |
2365 self setAcceptActionForClass. |
2366 codeView acceptAction:nil. |
2366 |
2367 ] ifFalse:[ |
2367 "/ currentClass isNamespace ifTrue:[ |
2368 codeView acceptAction:[:theCode | |
2368 "/ codeView acceptAction:nil. |
2369 |ns| |
2369 "/ ] ifFalse:[ |
2370 |
2370 "/ codeView acceptAction:[:theCode | |
2371 currentClass notNil ifTrue:[ |
2371 "/ |ns| |
2372 ns := currentClass nameSpace |
2372 "/ |
2373 ] ifFalse:[ |
2373 "/ currentClass notNil ifTrue:[ |
2374 ns := nil |
2374 "/ ns := currentClass nameSpace |
2375 ]. |
2375 "/ ] ifFalse:[ |
2376 |
2376 "/ ns := nil |
2377 codeView cursor:Cursor execute. |
2377 "/ ]. |
2378 |
2378 "/ |
2379 Class nameSpaceQuerySignal handle:[:ex | |
2379 "/ codeView cursor:Cursor execute. |
2380 ns isNil ifTrue:[ |
2380 "/ |
2381 ex reject |
2381 "/ Class nameSpaceQuerySignal handle:[:ex | |
2382 ]. |
2382 "/ ns isNil ifTrue:[ |
2383 ex proceedWith:ns |
2383 "/ ex reject |
2384 ] do:[ |
2384 "/ ]. |
2385 Object abortSignal catch:[ |
2385 "/ ex proceedWith:ns |
2386 |
2386 "/ ] do:[ |
2387 Class nameSpaceQuerySignal answer:Smalltalk |
2387 "/ Object abortSignal catch:[ |
2388 do:[ |
2388 "/ |
2389 (Compiler evaluate:theCode asString notifying:codeView compile:false) |
2389 "/ Class nameSpaceQuerySignal answer:Smalltalk |
2390 isBehavior ifTrue:[ |
2390 "/ do:[ |
2391 codeView modified:false. |
2391 "/ (Compiler evaluate:theCode asString notifying:codeView compile:false) |
2392 codeModified := false. |
2392 "/ isBehavior ifTrue:[ |
2393 self classCategoryUpdate. |
2393 "/ codeView modified:false. |
2394 self updateClassListWithScroll:false. |
2394 "/ codeModified := false. |
2395 ] |
2395 "/ self classCategoryUpdate. |
2396 ] |
2396 "/ self updateClassListWithScroll:false. |
2397 ]. |
2397 "/ ] |
2398 ]. |
2398 "/ ] |
2399 codeView cursor:Cursor normal. |
2399 "/ ]. |
2400 ]. |
2400 "/ ]. |
2401 ]. |
2401 "/ codeView cursor:Cursor normal. |
|
2402 "/ ]. |
|
2403 "/ ]. |
2402 codeView explainAction:nil. |
2404 codeView explainAction:nil. |
2403 |
2405 |
2404 methodListView notNil ifTrue:[ |
2406 methodListView notNil ifTrue:[ |
2405 methodListView setSelection:nil |
2407 methodListView setSelection:nil |
2406 ]. |
2408 ]. |
2407 aspect := #definition. |
2409 aspect := #definition. |
2408 self normalLabel |
2410 self normalLabel |
2409 ] |
2411 ] |
2410 |
2412 |
2411 "Modified: / 27.4.1998 / 15:35:33 / cg" |
2413 "Modified: / 17.6.1998 / 11:28:57 / cg" |
2412 ! |
2414 ! |
2413 |
2415 |
2414 classDocumentation |
2416 classDocumentation |
2415 "show classes documentation (i.e. open doc-View on it)" |
2417 "show classes documentation (i.e. open doc-View on it)" |
2416 |
2418 |
4735 codeView cursor:Cursor normal. |
4737 codeView cursor:Cursor normal. |
4736 ]. |
4738 ]. |
4737 ] ifFalse:[ |
4739 ] ifFalse:[ |
4738 "/ self classDefinition. |
4740 "/ self classDefinition. |
4739 self classListUpdate. |
4741 self classListUpdate. |
4740 |
4742 self setAcceptActionForClass. |
4741 currentClass isNamespace ifTrue:[ |
|
4742 codeView acceptAction:nil |
|
4743 ] ifFalse:[ |
|
4744 codeView acceptAction:[:theCode | |
|
4745 |ns| |
|
4746 |
|
4747 currentClass notNil ifTrue:[ |
|
4748 ns := currentClass nameSpace |
|
4749 ] ifFalse:[ |
|
4750 ns := nil |
|
4751 ]. |
|
4752 |
|
4753 codeView cursor:Cursor execute. |
|
4754 |
|
4755 Class nameSpaceQuerySignal handle:[:ex | |
|
4756 ns isNil ifTrue:[ |
|
4757 ex reject |
|
4758 ]. |
|
4759 ex proceedWith:ns |
|
4760 ] do:[ |
|
4761 Object abortSignal catch:[ |
|
4762 UndefinedObject createMinimumProtocolInNewSubclassQuery |
|
4763 answer:true |
|
4764 do:[ |
|
4765 (Compiler |
|
4766 evaluate:theCode asString |
|
4767 notifying:codeView |
|
4768 compile:false) |
|
4769 isBehavior ifTrue:[ |
|
4770 self classCategoryUpdate. |
|
4771 self updateClassListWithScroll:false. |
|
4772 codeView modified:false. |
|
4773 codeModified := false. |
|
4774 ]. |
|
4775 ] |
|
4776 ]. |
|
4777 ]. |
|
4778 codeView cursor:Cursor normal. |
|
4779 ]. |
|
4780 ] |
|
4781 ]. |
4743 ]. |
4782 codeView explainAction:nil. |
4744 codeView explainAction:nil. |
4783 |
4745 |
4784 (classCategoryListView notNil and:[currentClass notNil]) ifTrue:[ |
4746 (classCategoryListView notNil and:[currentClass notNil]) ifTrue:[ |
4785 (currentClassCategory = currentClass category) ifFalse:[ |
4747 (currentClassCategory = currentClass category) ifFalse:[ |
4794 |
4756 |
4795 self setDoitActionForClass |
4757 self setDoitActionForClass |
4796 ] |
4758 ] |
4797 |
4759 |
4798 "Created: / 23.11.1995 / 11:32:03 / cg" |
4760 "Created: / 23.11.1995 / 11:32:03 / cg" |
4799 "Modified: / 19.4.1998 / 21:04:07 / cg" |
4761 "Modified: / 17.6.1998 / 11:05:06 / cg" |
4800 ! |
4762 ! |
4801 |
4763 |
4802 classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate |
4764 classTemplateFor:aSuperClass in:categoryString namespace:isNameSpace private:isPrivate |
4803 "return a class definition template - be smart in what is offered initially" |
4765 "return a class definition template - be smart in what is offered initially" |
4804 |
4766 |
9167 If this is ST/X a ' , 'demo-distribution' asText allBold ,', the source for some classes is not |
9129 If this is ST/X a ' , 'demo-distribution' asText allBold ,', the source for some classes is not |
9168 published, and this is normal behavior. |
9130 published, and this is normal behavior. |
9169 Notice, that it is possible to add new methods - even with missing sources. |
9131 Notice, that it is possible to add new methods - even with missing sources. |
9170 |
9132 |
9171 "'. |
9133 "'. |
9172 codeView acceptAction:[:text | nil]. |
9134 codeView acceptAction:nil. |
9173 ] ifFalse:[ |
9135 ] ifFalse:[ |
9174 UserPreferences current syntaxColoring ifTrue:[ |
9136 UserPreferences current syntaxColoring ifTrue:[ |
9175 highlighter := actualClass syntaxHighlighterClass. |
9137 highlighter := actualClass syntaxHighlighterClass. |
9176 highlighter notNil ifTrue:[ |
9138 highlighter notNil ifTrue:[ |
9177 code size < 5000 ifTrue:[ |
9139 code size < 5000 ifTrue:[ |
10362 ^ sel string |
10324 ^ sel string |
10363 |
10325 |
10364 "Modified: 30.7.1997 / 15:30:10 / cg" |
10326 "Modified: 30.7.1997 / 15:30:10 / cg" |
10365 ! |
10327 ! |
10366 |
10328 |
|
10329 setAcceptActionForClass |
|
10330 "tell the codeView what to do on accept and explain" |
|
10331 |
|
10332 currentClass isNamespace ifTrue:[ |
|
10333 codeView acceptAction:nil |
|
10334 ] ifFalse:[ |
|
10335 codeView acceptAction:[:theCode | |
|
10336 |ns| |
|
10337 |
|
10338 currentClass notNil ifTrue:[ |
|
10339 ns := currentClass nameSpace |
|
10340 ] ifFalse:[ |
|
10341 ns := nil |
|
10342 ]. |
|
10343 |
|
10344 codeView cursor:Cursor execute. |
|
10345 |
|
10346 Class nameSpaceQuerySignal handle:[:ex | |
|
10347 ns isNil ifTrue:[ |
|
10348 ex reject |
|
10349 ]. |
|
10350 ex proceedWith:ns |
|
10351 ] do:[ |
|
10352 Object abortSignal catch:[ |
|
10353 UndefinedObject createMinimumProtocolInNewSubclassQuery |
|
10354 answer:true |
|
10355 do:[ |
|
10356 (Class classRedefinitionSignal)handle:[:ex | |
|
10357 |answer oldVsNew oldPkg newPkg| |
|
10358 |
|
10359 oldVsNew := ex parameter. |
|
10360 oldPkg := oldVsNew key package. |
|
10361 newPkg := oldVsNew value package. |
|
10362 answer := OptionBox |
|
10363 request: |
|
10364 ('You are about to define a class from another (system-) package. |
|
10365 The classes original packageID was ''%1''. |
|
10366 If you proceed, the new class will be marked as belonging |
|
10367 to the ''%2'' package (and this warning will not be shown again). |
|
10368 If you proceed with ''keep'', the class will be installed |
|
10369 but the old packageID will be preserved. |
|
10370 Otherwise, hit ''cancel'' to leave the class unchanged. |
|
10371 |
|
10372 PS: you can disable these checks in the launchers settings-compilation dialog.' |
|
10373 bindWith:(oldPkg asText allBold) |
|
10374 with:(newPkg asText allBold)) |
|
10375 |
|
10376 label:'Class redefinition' |
|
10377 form:(WarningBox iconBitmap) |
|
10378 buttonLabels:#('cancel' 'keep' 'continue') |
|
10379 values:#(#cancel #keep #continue) |
|
10380 default:#continue. |
|
10381 |
|
10382 (answer ~~ #cancel) ifTrue:[ |
|
10383 ex proceedWith:answer |
|
10384 ] |
|
10385 ] do:[ |
|
10386 |rslt| |
|
10387 |
|
10388 rslt := Compiler |
|
10389 evaluate:theCode asString |
|
10390 notifying:codeView |
|
10391 compile:false. |
|
10392 |
|
10393 rslt isBehavior ifTrue:[ |
|
10394 self classCategoryUpdate. |
|
10395 self updateClassListWithScroll:false. |
|
10396 codeView modified:false. |
|
10397 codeModified := false. |
|
10398 ]. |
|
10399 ] |
|
10400 ] |
|
10401 ]. |
|
10402 ]. |
|
10403 codeView cursor:Cursor normal. |
|
10404 ]. |
|
10405 ] |
|
10406 |
|
10407 "Modified: / 17.6.1998 / 11:39:02 / cg" |
|
10408 ! |
|
10409 |
10367 setAcceptAndExplainActionsForMethod |
10410 setAcceptAndExplainActionsForMethod |
10368 "tell the codeView what to do on accept and explain" |
10411 "tell the codeView what to do on accept and explain" |
10369 |
10412 |
10370 codeView acceptAction:[:theCode | |
10413 codeView acceptAction:[:theCode | |
10371 |cat cls rslt| |
10414 |cat cls rslt| |
10391 ]. |
10434 ]. |
10392 (cat notNil and:[cat notEmpty]) ifTrue:[ |
10435 (cat notNil and:[cat notEmpty]) ifTrue:[ |
10393 Object abortSignal catch:[ |
10436 Object abortSignal catch:[ |
10394 lockUpdates := true. |
10437 lockUpdates := true. |
10395 |
10438 |
10396 Class methodRedefinitionSignal handle:[:ex | |
10439 (Class methodRedefinitionSignal) handle:[:ex | |
10397 |answer oldVsNew oldPkg newPkg| |
10440 |answer oldVsNew oldPkg newPkg| |
10398 |
10441 |
10399 oldVsNew := ex parameter. |
10442 oldVsNew := ex parameter. |
10400 oldPkg := oldVsNew key package. |
10443 oldPkg := oldVsNew key package. |
10401 newPkg := oldVsNew value package. |
10444 newPkg := oldVsNew value package. |
10402 answer := OptionBox |
10445 answer := OptionBox |
10403 request: |
10446 request: |
10404 ('You are about to change code from another (system-) package. |
10447 ('You are about to change a method from another (system-) package. |
10405 The methods original packageID was ''%1''. |
10448 The methods original packageID was ''%1''. |
10406 If you proceed, the new code will be marked as belonging |
10449 If you proceed, the new method will be marked as belonging |
10407 to the ''%2'' package (and this warning will not be shown again). |
10450 to the ''%2'' package (and this warning will not be shown again). |
10408 If you proceed with ''keep'', the old packageID will be preserved. |
10451 If you proceed with ''keep'', the new method will be installed |
|
10452 but the old packageID will be preserved. |
10409 Otherwise, hit ''cancel'' to leave the code unchanged. |
10453 Otherwise, hit ''cancel'' to leave the code unchanged. |
10410 |
10454 |
10411 PS: you can disable these checks in the launchers settings-compilation dialog.' bindWith:oldPkg with:newPkg) |
10455 PS: you can disable these checks in the launchers settings-compilation dialog.' |
|
10456 bindWith:(oldPkg asText allBold) |
|
10457 with:(newPkg asText allBold)) |
10412 |
10458 |
10413 label:'Method redefinition' |
10459 label:'Method redefinition' |
10414 form:(WarningBox iconBitmap) |
10460 form:(WarningBox iconBitmap) |
10415 buttonLabels:#('cancel' 'keep' 'continue') |
10461 buttonLabels:#('cancel' 'keep' 'continue') |
10416 values:#(#cancel #keep #continue) |
10462 values:#(#cancel #keep #continue) |
10444 explain:theSelection |
10490 explain:theSelection |
10445 in:theCode |
10491 in:theCode |
10446 forClass:actualClass) |
10492 forClass:actualClass) |
10447 ]. |
10493 ]. |
10448 |
10494 |
10449 "Modified: / 31.3.1998 / 23:40:23 / cg" |
10495 "Modified: / 17.6.1998 / 11:38:35 / cg" |
10450 ! |
10496 ! |
10451 |
10497 |
10452 setDoitActionForClass |
10498 setDoitActionForClass |
10453 "tell the codeView what to do on doIt" |
10499 "tell the codeView what to do on doIt" |
10454 |
10500 |
10455 "set self for doits. This allows accessing the current class |
10501 "set self for doits. This allows accessing the current class |
10456 as self, and access to the class variables by name. |
10502 as self, and access to the class variables by name. |
10457 " |
10503 " |
10458 codeView doItAction:[:theCode | |
10504 codeView doItAction:[:theCode | |
10459 |compiler ns| |
10505 |compiler ns| |
10460 |
10506 |
10461 currentClass notNil ifTrue:[ |
10507 currentClass notNil ifTrue:[ |
10462 ns := currentClass nameSpace |
10508 ns := currentClass nameSpace |
10463 ] ifFalse:[ |
10509 ] ifFalse:[ |
10464 ns := nil |
10510 ns := nil |
10465 ]. |
10511 ]. |
10466 |
10512 |
10467 Class nameSpaceQuerySignal handle:[:ex | |
10513 Class nameSpaceQuerySignal handle:[:ex | |
10468 ns isNil ifTrue:[ |
10514 ns isNil ifTrue:[ |
10469 ex reject |
10515 ex reject |
10470 ]. |
10516 ]. |
10471 ex proceedWith:ns |
10517 ex proceedWith:ns |
10472 ] do:[ |
10518 ] do:[ |
10473 currentClass isNil ifTrue:[ |
10519 currentClass isNil ifTrue:[ |
10474 compiler := Compiler |
10520 compiler := Compiler |
10475 ] ifFalse:[ |
10521 ] ifFalse:[ |
10476 compiler := currentClass evaluatorClass |
10522 compiler := currentClass evaluatorClass |
10477 ]. |
10523 ]. |
10478 |
10524 |
10479 compiler |
10525 compiler |
10480 evaluate:theCode |
10526 evaluate:theCode |
10481 in:nil |
10527 in:nil |
10482 receiver:currentClass |
10528 receiver:currentClass |
10483 notifying:codeView |
10529 notifying:codeView |
10484 logged:false |
10530 logged:false |
10485 ifFail:nil |
10531 ifFail:nil |
10486 ] |
10532 ] |
10487 ]. |
10533 ]. |
10488 |
10534 |
10489 "Modified: 10.2.1997 / 14:17:15 / cg" |
10535 "Modified: / 17.6.1998 / 11:35:44 / cg" |
10490 ! |
10536 ! |
10491 |
10537 |
10492 setSearchPattern:aString |
10538 setSearchPattern:aString |
10493 codeView setSearchPattern:aString |
10539 codeView setSearchPattern:aString |
10494 ! |
10540 ! |