1007 ] |
1020 ] |
1008 ]. |
1021 ]. |
1009 ^ true. |
1022 ^ true. |
1010 |
1023 |
1011 "Modified: / 09-02-2011 / 13:54:01 / cg" |
1024 "Modified: / 09-02-2011 / 13:54:01 / cg" |
|
1025 ! |
|
1026 |
|
1027 checkinBuildSupportFilesForPackage:packageID |
|
1028 |
|
1029 |anyFailure module directory mgr defClass | |
|
1030 |
|
1031 mgr := self sourceCodeManagerFor: packageID. |
|
1032 defClass := ProjectDefinition definitionClassForPackage: packageID. |
|
1033 |
|
1034 defClass validateDescription. |
|
1035 |
|
1036 anyFailure := false. |
|
1037 |
|
1038 module := packageID asPackageId module. |
|
1039 directory := packageID asPackageId directory. |
|
1040 |
|
1041 self activityNotification:(resources string:'checking in build-support files...'). |
|
1042 (mgr checkForExistingModule:module directory:directory) ifFalse:[ |
|
1043 mgr createModule:module directory:directory |
|
1044 ]. |
|
1045 defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents | |
|
1046 |realFileName realDirectory| |
|
1047 |
|
1048 "/ care for subdirectories |
|
1049 (fileName includes:$/) ifTrue:[ |
|
1050 realDirectory := (directory asFilename construct:(fileName asFilename directoryName)) name. |
|
1051 realFileName := fileName asFilename baseName. |
|
1052 ] ifFalse:[ |
|
1053 realDirectory := directory. |
|
1054 realFileName := fileName. |
|
1055 ]. |
|
1056 realDirectory := realDirectory replaceAll:$\ with:$/. |
|
1057 |
|
1058 self activityNotification:(resources string:'checking in %1...' with:realFileName). |
|
1059 |
|
1060 UserInformation |
|
1061 handle:[:ex | Transcript showCR:ex description ] |
|
1062 do:[ |
|
1063 (mgr |
|
1064 checkForExistingContainer:realFileName inModule:module directory:realDirectory) |
|
1065 ifFalse:[ |
|
1066 realDirectory ~= directory ifTrue:[ |
|
1067 (mgr checkForExistingModule:module directory:realDirectory) ifFalse:[ |
|
1068 mgr createModule:module directory:realDirectory |
|
1069 ]. |
|
1070 ]. |
|
1071 (mgr |
|
1072 createContainerForText:fileContents |
|
1073 inModule:module |
|
1074 package:realDirectory |
|
1075 container:realFileName) |
|
1076 ifFalse:[ |
|
1077 Dialog warn:(resources |
|
1078 stringWithCRs:'Cannot create new container: ''%3'' (in %1:%2)' |
|
1079 with:module |
|
1080 with:realDirectory |
|
1081 with:realFileName) |
|
1082 ]. |
|
1083 ] ifTrue:[ |
|
1084 (mgr |
|
1085 checkin:realFileName |
|
1086 text:fileContents |
|
1087 directory:realDirectory |
|
1088 module:module |
|
1089 logMessage:'automatically generated by browser' |
|
1090 force:false) |
|
1091 ifFalse:[ |
|
1092 Transcript showCR:'checkin of ' , realFileName , ' failed'. |
|
1093 anyFailure := true. |
|
1094 ]. |
|
1095 ]. |
|
1096 ]. |
|
1097 ]. |
|
1098 |
|
1099 defClass instAndClassMethodsDo:[:m | m package:defClass package]. |
|
1100 |
|
1101 self |
|
1102 checkinClasses:(Array with:defClass) |
|
1103 withInfo:'automatic checkIn' |
|
1104 withCheck:false. |
|
1105 |
|
1106 |
|
1107 self activityNotification:nil. |
|
1108 |
|
1109 anyFailure ifTrue:[ |
|
1110 self warn:'Checkin failed - see Transcript.'. |
|
1111 self activityNotification:'Checkin of build-support files failed - see Transcript.'. |
|
1112 ] ifFalse:[ |
|
1113 self activityNotification:'Build-support files checked into the repository.'. |
|
1114 ]. |
|
1115 |
|
1116 "Created: / 09-08-2006 / 18:59:42 / fm" |
|
1117 "Modified: / 16-08-2006 / 18:38:49 / User" |
|
1118 "Created: / 06-09-2011 / 08:00:57 / cg" |
|
1119 "Modified: / 12-10-2011 / 11:36:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
1120 "Created: / 13-10-2011 / 11:15:29 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
1012 ! |
1121 ! |
1013 |
1122 |
1014 checkinClass:aClass |
1123 checkinClass:aClass |
1015 "check a class into the source repository. |
1124 "check a class into the source repository. |
1016 Asks interactively for a log-message." |
1125 Asks interactively for a log-message." |
1381 ]. |
1490 ]. |
1382 ]. |
1491 ]. |
1383 ^ true |
1492 ^ true |
1384 |
1493 |
1385 "Modified: / 12-09-2006 / 14:14:49 / cg" |
1494 "Modified: / 12-09-2006 / 14:14:49 / cg" |
|
1495 ! |
|
1496 |
|
1497 checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages |
|
1498 |mgr classes classesToCheckIn methodsToCheckIn |
|
1499 methodsInOtherPackages looseMethods otherPackages |
|
1500 msg classesInChangeSet checkinInfo originalCheckinInfo classesToTag| |
|
1501 |
|
1502 mgr := self sourceCodeManagerFor: packageToCheckIn. |
|
1503 classes := Smalltalk allClasses. |
|
1504 |
|
1505 classesToCheckIn := IdentitySet new. |
|
1506 methodsToCheckIn := IdentitySet new. |
|
1507 methodsInOtherPackages := IdentitySet new. |
|
1508 looseMethods := IdentitySet new. |
|
1509 |
|
1510 "/ classes ... |
|
1511 classes do:[:aClass | |owner classPackage| |
|
1512 (owner := aClass owningClass) notNil ifTrue:[ |
|
1513 classPackage := aClass topOwningClass package |
|
1514 ] ifFalse:[ |
|
1515 classPackage := aClass package |
|
1516 ]. |
|
1517 (classPackage = packageToCheckIn) ifTrue:[ |
|
1518 classesToCheckIn add:aClass. |
|
1519 ]. |
|
1520 ]. |
|
1521 |
|
1522 "/ cg: O(n^2) algorithm |
|
1523 "/ classesInChangeSet := classesToCheckIn select:[:cls | cls hasUnsavedChanges]. |
|
1524 "/ replaced by: O(n) algorithm |
|
1525 classesInChangeSet := ChangeSet current selectForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classesToCheckIn. |
|
1526 |
|
1527 "/ individual methods ... |
|
1528 classes do:[:aClass | |
|
1529 aClass isMeta ifFalse:[ |
|
1530 "/ ... whose class is not in the chechIn-set |
|
1531 (classesToCheckIn includes:aClass) ifFalse:[ |
|
1532 aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
|
1533 "/ methods in this project ... |
|
1534 (mthd package = packageToCheckIn) ifTrue:[ |
|
1535 methodsToCheckIn add:mthd |
|
1536 ] |
|
1537 ] |
|
1538 ]. |
|
1539 ]. |
|
1540 ]. |
|
1541 |
|
1542 doExtensions ifTrue:[ |
|
1543 methodsToCheckIn notEmpty ifTrue:[ |
|
1544 doClasses ifTrue:[ |
|
1545 msg := '%1 classes (%4 changed) '. |
|
1546 ] ifFalse:[ |
|
1547 msg := ''. |
|
1548 ]. |
|
1549 doExtensions ifTrue:[ |
|
1550 doClasses ifTrue:[ |
|
1551 msg := msg , 'and '. |
|
1552 ]. |
|
1553 msg := msg , '%2 extensions '. |
|
1554 ]. |
|
1555 msg := msg , 'of project "%3"'. |
|
1556 |
|
1557 checkinInfo := self |
|
1558 getCheckinInfoFor:(msg |
|
1559 bindWith:classesToCheckIn size |
|
1560 with:methodsToCheckIn size |
|
1561 with:packageToCheckIn allBold |
|
1562 with:classesInChangeSet size) |
|
1563 initialAnswer:nil |
|
1564 withQuickOption:(classesToCheckIn size > 0). |
|
1565 checkinInfo isNil ifTrue:[ |
|
1566 ^ self. |
|
1567 ]. |
|
1568 (self |
|
1569 checkinExtensionMethods:methodsToCheckIn |
|
1570 forPackage:packageToCheckIn |
|
1571 withInfo:checkinInfo) |
|
1572 ifFalse:[ |
|
1573 Dialog warn:(resources string:'Could not check in extensions for project %1' with:packageToCheckIn). |
|
1574 ^ self. |
|
1575 ] |
|
1576 ] ifFalse:[ |
|
1577 "/ there may have been extension-methods previously - if so, remove them |
|
1578 (mgr |
|
1579 checkForExistingContainer:'extensions.st' inPackage:packageToCheckIn) |
|
1580 ifTrue:[ |
|
1581 "/ self halt. |
|
1582 (self |
|
1583 checkinExtensionMethods:#() |
|
1584 forPackage:packageToCheckIn |
|
1585 withInfo:'No extensions any more') |
|
1586 ifFalse:[ |
|
1587 Dialog warn:(resources string:'Could not check in extensions for project %1' with:packageToCheckIn). |
|
1588 ^ self. |
|
1589 ] |
|
1590 ] |
|
1591 ]. |
|
1592 ]. |
|
1593 |
|
1594 checkinInfo isNil ifTrue:[ |
|
1595 checkinInfo := self |
|
1596 getCheckinInfoFor:('%1 classes (%4 changed) and %2 extensions for project "%3"' |
|
1597 bindWith:classesToCheckIn size |
|
1598 with:methodsToCheckIn size |
|
1599 with:packageToCheckIn allBold |
|
1600 with:classesInChangeSet size) |
|
1601 initialAnswer:nil |
|
1602 withQuickOption:(classesToCheckIn size > 0). |
|
1603 checkinInfo isNil ifTrue:[ |
|
1604 ^ self. |
|
1605 ]. |
|
1606 ]. |
|
1607 |
|
1608 checkinInfo quickCheckIn ifTrue:[ |
|
1609 (checkinInfo isStable or:[checkinInfo tagIt]) ifTrue:[ |
|
1610 classesToTag := classesToCheckIn. |
|
1611 originalCheckinInfo := checkinInfo. |
|
1612 checkinInfo := checkinInfo copy. |
|
1613 checkinInfo isStable:false. |
|
1614 checkinInfo tag:nil. |
|
1615 ]. |
|
1616 classesToCheckIn := classesInChangeSet. |
|
1617 ]. |
|
1618 |
|
1619 "/ check if any of the classes contains methods for other packages ... |
|
1620 classesToCheckIn do:[:eachClass | |
|
1621 eachClass instAndClassMethodsDo:[:eachMethod | |
|
1622 |mPgk| |
|
1623 |
|
1624 mPgk := eachMethod package. |
|
1625 (mPgk = packageToCheckIn) ifFalse:[ |
|
1626 mPgk == PackageId noProjectID ifTrue:[ |
|
1627 looseMethods add:eachMethod |
|
1628 ] ifFalse:[ |
|
1629 methodsInOtherPackages add:eachMethod |
|
1630 ] |
|
1631 ] |
|
1632 ]. |
|
1633 ]. |
|
1634 |
|
1635 askForMethodsInOtherPackages ifTrue:[ |
|
1636 methodsInOtherPackages notEmpty ifTrue:[ |
|
1637 otherPackages := Set new. |
|
1638 methodsInOtherPackages do:[:eachMethod | otherPackages add:eachMethod package]. |
|
1639 |
|
1640 methodsInOtherPackages size == 1 ifTrue:[ |
|
1641 msg := 'The ''%4'' method in ''%5'' is contained in the ''%2'' package.'. |
|
1642 msg := msg , '\\This method will remain in its package.'. |
|
1643 ] ifFalse:[ |
|
1644 otherPackages size == 1 ifTrue:[ |
|
1645 msg := 'The %1 methods from the %2 package will remain in its package.' |
|
1646 ] ifFalse:[ |
|
1647 msg := 'The %1 methods from %3 other packages will remain in their packages.' |
|
1648 ]. |
|
1649 msg := msg , '\\Hint: if these are meant to belong to this package,'. |
|
1650 msg := msg , '\move them first, then repeat the checkin operation.'. |
|
1651 ]. |
|
1652 msg := msg withCRs. |
|
1653 msg := msg bindWith:methodsInOtherPackages size |
|
1654 with:otherPackages first allBold |
|
1655 with:otherPackages size |
|
1656 with:methodsInOtherPackages first selector allBold |
|
1657 with:methodsInOtherPackages first mclass name allBold. |
|
1658 (Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self]. |
|
1659 ]. |
|
1660 ]. |
|
1661 |
|
1662 doClasses ifTrue:[ |
|
1663 classesToCheckIn notEmpty ifTrue:[ |
|
1664 looseMethods notEmpty ifTrue:[ |
|
1665 looseMethods size == 1 ifTrue:[ |
|
1666 msg := 'The ''%2'' method in ''%3'' is unassigned (loose).'. |
|
1667 msg := msg , '\\If you proceed, this method will be moved to the ''%4'' package'. |
|
1668 msg := msg , '\\Hint: if this is meant to be an extension of another package,'. |
|
1669 msg := msg , '\cancel and move it to the appropriate package first.'. |
|
1670 ] ifFalse:[ |
|
1671 msg := 'There are %1 unassigned (loose) methods in classes from this project.'. |
|
1672 msg := msg , '\\If you proceed, those will be moved to the ''%4'' package ?'. |
|
1673 msg := msg , '\\Hint: if these are meant to be extensions of another package,'. |
|
1674 msg := msg , '\cancel and move them to the appropriate package first.'. |
|
1675 ]. |
|
1676 doClasses ifTrue:[ |
|
1677 msg := msg , '\\If you answer with "No" here, you will be asked for each class individually.'. |
|
1678 ]. |
|
1679 msg := msg withCRs. |
|
1680 msg := msg bindWith:looseMethods size |
|
1681 with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first selector allBold]) |
|
1682 with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first mclass name allBold]) |
|
1683 with:packageToCheckIn allBold. |
|
1684 (Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self]. |
|
1685 |
|
1686 looseMethods do:[:mthd | |
|
1687 mthd package:packageToCheckIn |
|
1688 ]. |
|
1689 ]. |
|
1690 self checkinClasses:classesToCheckIn withInfo:checkinInfo. |
|
1691 ]. |
|
1692 |
|
1693 originalCheckinInfo notNil ifTrue:[ |
|
1694 originalCheckinInfo isStable ifTrue:[ |
|
1695 classesToTag do:[:eachClass | |
|
1696 self tagClass:eachClass as:#stable |
|
1697 ]. |
|
1698 ]. |
|
1699 originalCheckinInfo tagIt ifTrue:[ |
|
1700 classesToTag do:[:eachClass | |
|
1701 self tagClass:eachClass as:(originalCheckinInfo tag) |
|
1702 ]. |
|
1703 ]. |
|
1704 ]. |
|
1705 ]. |
|
1706 |
|
1707 doBuild ifTrue:[ |
|
1708 self checkinBuildSupportFilesForPackage:packageToCheckIn |
|
1709 ]. |
|
1710 |
|
1711 "Modified: / 08-09-2011 / 04:42:38 / cg" |
|
1712 "Created: / 13-10-2011 / 11:15:22 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
1386 ! |
1713 ! |
1387 |
1714 |
1388 checkoutClass:aClass askForMerge:askForMerge |
1715 checkoutClass:aClass askForMerge:askForMerge |
1389 "check-out a class from the source repository." |
1716 "check-out a class from the source repository." |
1390 |
1717 |