1087 |
1097 |
1088 |labels selectors m| |
1098 |labels selectors m| |
1089 |
1099 |
1090 (device ctrlDown |
1100 (device ctrlDown |
1091 and:[currentClass notNil]) ifTrue:[ |
1101 and:[currentClass notNil]) ifTrue:[ |
1092 labels := #( |
1102 labels := #( |
1093 'inspect class' |
1103 'inspect class' |
1094 '-' |
1104 '-' |
1095 'primitive definitions' |
1105 'primitive definitions' |
1096 'primitive variables' |
1106 'primitive variables' |
1097 'primitive functions' |
1107 'primitive functions' |
1098 ). |
1108 ). |
1099 selectors := #( |
1109 selectors := #( |
1100 classInspect |
1110 classInspect |
1101 nil |
1111 nil |
1102 classPrimitiveDefinitions |
1112 classPrimitiveDefinitions |
1103 classPrimitiveVariables |
1113 classPrimitiveVariables |
1104 classPrimitiveFunctions |
1114 classPrimitiveFunctions |
1105 ). |
1115 ). |
1106 |
1116 |
1107 labels := labels , #( |
1117 labels := labels , #( |
1108 '-' |
1118 '-' |
1109 'revision info' |
1119 'revision info' |
1110 'compare with repository' |
1120 'compare with repository' |
1111 '-' |
1121 '-' |
1112 'check into source repository' |
1122 'check into source repository' |
1113 'fileIn from repository' |
1123 'fileIn from repository' |
1114 ). |
1124 ). |
1115 |
1125 |
1116 selectors := selectors , #( |
1126 selectors := selectors , #( |
1117 nil |
1127 nil |
1118 classRevisionInfo |
1128 classRevisionInfo |
1119 classCompareWithNewestInRepository |
1129 classCompareWithNewestInRepository |
1120 nil |
1130 nil |
1121 classCheckin |
1131 classCheckin |
1122 classLoadRevision |
1132 classLoadRevision |
1123 ). |
1133 ). |
1124 ] ifFalse:[ |
1134 ] ifFalse:[ |
1125 currentClass isNil ifTrue:[ |
1135 currentClass isNil ifTrue:[ |
1126 labels := #( |
1136 labels := #( |
1127 'new class' |
1137 'new class' |
1128 ). |
1138 ). |
1129 selectors := #( |
1139 selectors := #( |
1130 classNewClass |
1140 classNewClass |
1131 ). |
1141 ). |
1132 ] ifFalse:[ |
1142 ] ifFalse:[ |
1133 currentClass isLoaded ifFalse:[ |
1143 currentClass isLoaded ifFalse:[ |
1134 labels := #( |
1144 labels := #( |
1135 'definition' |
1145 'definition' |
1136 '-' |
1146 '-' |
1137 'new class' |
1147 'new class' |
1138 '-' |
1148 '-' |
1139 'load ' |
1149 'load ' |
1140 ). |
1150 ). |
1141 selectors := #( |
1151 selectors := #( |
1142 classDefinition |
1152 classDefinition |
1143 nil |
1153 nil |
1144 classNewClass |
1154 classNewClass |
1145 nil |
1155 nil |
1146 classLoad |
1156 classLoad |
1147 ). |
1157 ). |
1148 ] ifTrue:[ |
1158 ] ifTrue:[ |
1149 fullProtocol ifTrue:[ |
1159 fullProtocol ifTrue:[ |
1150 labels := #( |
1160 labels := #( |
1151 'hierarchy' |
1161 'hierarchy' |
1152 'definition' |
1162 'definition' |
1153 'comment' |
1163 'comment' |
1154 'class instvars' |
1164 'class instvars' |
1155 ). |
1165 ). |
1156 selectors := #( |
1166 selectors := #( |
1157 classHierarchy |
1167 classHierarchy |
1158 classDefinition |
1168 classDefinition |
1159 classComment |
1169 classComment |
1160 classClassInstVars |
1170 classClassInstVars |
1161 ). |
1171 ). |
1162 ] ifFalse:[ |
1172 ] ifFalse:[ |
1163 labels := #( |
1173 labels := #( |
1164 'fileOut' |
1174 'fileOut' |
1165 'printOut' |
1175 'printOut' |
1166 'printOut protocol' |
1176 'printOut protocol' |
1167 " 'printOut full protocol' " |
1177 " 'printOut full protocol' " |
1168 '-' |
1178 '-' |
1169 'SPAWN_CLASS' |
1179 'SPAWN_CLASS' |
1170 'spawn full protocol' |
1180 'spawn full protocol' |
1171 'spawn hierarchy' |
1181 'spawn hierarchy' |
1172 'spawn subclasses' |
1182 'spawn subclasses' |
1173 '-' |
1183 '-' |
1174 ). |
1184 ). |
1175 selectors := #( |
1185 selectors := #( |
1176 classFileOut |
1186 classFileOut |
1177 classPrintOut |
1187 classPrintOut |
1178 classPrintOutProtocol |
1188 classPrintOutProtocol |
1179 " classPrintOutFullProtocol " |
1189 " classPrintOutFullProtocol " |
1180 nil |
1190 nil |
1181 classSpawn |
1191 classSpawn |
1182 classSpawnFullProtocol |
1192 classSpawnFullProtocol |
1183 classSpawnHierarchy |
1193 classSpawnHierarchy |
1184 classSpawnSubclasses |
1194 classSpawnSubclasses |
1185 nil |
1195 nil |
1186 ). |
1196 ). |
1187 |
1197 |
1188 fullClass ifFalse:[ |
1198 fullClass ifFalse:[ |
1189 labels := labels , #( |
1199 labels := labels , #( |
1190 'hierarchy' |
1200 'hierarchy' |
1191 'definition' |
1201 'definition' |
1192 'comment' |
1202 'comment' |
1193 'class instvars' |
1203 'class instvars' |
1194 "/ 'protocols' |
1204 "/ 'protocols' |
1195 '-' |
1205 '-' |
1196 ). |
1206 ). |
1197 selectors := selectors , #( |
1207 selectors := selectors , #( |
1198 classHierarchy |
1208 classHierarchy |
1199 classDefinition |
1209 classDefinition |
1200 classComment |
1210 classComment |
1201 classClassInstVars |
1211 classClassInstVars |
1202 "/ classProtocols |
1212 "/ classProtocols |
1203 nil |
1213 nil |
1204 ). |
1214 ). |
1205 ]. |
1215 ]. |
1206 |
1216 |
1207 labels := labels , #( |
1217 labels := labels , #( |
1208 "/ 'variable search' |
1218 "/ 'variable search' |
1209 'class refs' |
1219 'class refs' |
1210 '-' |
1220 '-' |
1211 'new class' |
1221 'new class' |
1212 'new subclass' |
1222 'new subclass' |
1213 'rename ...' |
1223 'rename ...' |
1214 'remove' |
1224 'remove' |
1215 ). |
1225 ). |
1216 selectors := selectors , #( |
1226 selectors := selectors , #( |
1217 "/ variables |
1227 "/ variables |
1218 classRefs |
1228 classRefs |
1219 nil |
1229 nil |
1220 classNewClass |
1230 classNewClass |
1221 classNewSubclass |
1231 classNewSubclass |
1222 classRename |
1232 classRename |
1223 classRemove |
1233 classRemove |
1224 ). |
1234 ). |
1225 currentClass wasAutoloaded ifTrue:[ |
1235 currentClass wasAutoloaded ifTrue:[ |
1226 labels := labels , #( |
1236 labels := labels , #( |
1227 'unload' |
1237 'unload' |
1228 ). |
1238 ). |
1229 selectors := selectors , #( |
1239 selectors := selectors , #( |
1230 classUnload |
1240 classUnload |
1231 ). |
1241 ). |
1232 ] |
1242 ] |
1233 ] |
1243 ] |
1234 ]. |
1244 ]. |
1235 ]. |
1245 ]. |
1236 ]. |
1246 ]. |
1237 |
1247 |
1238 |
1248 |
1239 m := PopUpMenu |
1249 m := PopUpMenu |
1240 labels:(resources array:labels) |
1250 labels:(resources array:labels) |
1241 selectors:selectors. |
1251 selectors:selectors. |
1242 |
1252 |
1243 (currentClass isNil |
1253 (currentClass isNil |
1244 or:[currentClass sourceCodeManager isNil]) ifTrue:[ |
1254 or:[currentClass sourceCodeManager isNil]) ifTrue:[ |
1245 m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository). |
1255 m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository). |
1246 ]. |
1256 ]. |
1247 |
1257 |
1248 ^ m |
1258 ^ m |
1249 |
1259 |
1250 "Modified: 7.12.1995 / 23:56:14 / cg" |
1260 "Modified: 7.12.1995 / 23:56:14 / cg" |
1630 |
1640 |
1631 classCheckin |
1641 classCheckin |
1632 "check a class into the source repository" |
1642 "check a class into the source repository" |
1633 |
1643 |
1634 currentClass isLoaded ifFalse:[ |
1644 currentClass isLoaded ifFalse:[ |
1635 self warn:'cannot checkin unloaded classes.'. |
1645 self warn:'cannot checkin unloaded classes.'. |
1636 ^ self. |
1646 ^ self. |
1637 ]. |
1647 ]. |
1638 |
1648 |
1639 self doClassMenu:[:currentClass | |
1649 self doClassMenu:[:currentClass | |
1640 |logMessage info mgr| |
1650 |logMessage info mgr| |
1641 |
1651 |
1642 mgr := (currentClass sourceCodeManager). |
1652 mgr := (currentClass sourceCodeManager). |
1643 (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[ |
1653 (info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[ |
1644 ^ self classCreateSourceContainerFor:currentClass |
1654 ^ self classCreateSourceContainerFor:currentClass |
1645 ]. |
1655 ]. |
1646 |
1656 |
1647 logMessage := Dialog |
1657 logMessage := Dialog |
1648 request:'enter a log message:' |
1658 request:'enter a log message:' |
1649 initialAnswer:lastSourceLogMessage |
1659 initialAnswer:lastSourceLogMessage |
1650 onCancel:nil. |
1660 onCancel:nil. |
1651 |
1661 |
1652 logMessage notNil ifTrue:[ |
1662 logMessage notNil ifTrue:[ |
1653 lastSourceLogMessage := logMessage. |
1663 lastSourceLogMessage := logMessage. |
1654 self busyLabel:'checking in %1' with:currentClass name. |
1664 self busyLabel:'checking in %1' with:currentClass name. |
1655 (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[ |
1665 (mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[ |
1656 self warn:'checkin failed'. |
1666 self warn:'checkin failed'. |
1657 ]. |
1667 ]. |
1658 aspect == #revisionInfo ifTrue:[ |
1668 aspect == #revisionInfo ifTrue:[ |
1659 self classListUpdate |
1669 self classListUpdate |
1660 ]. |
1670 ]. |
1661 self normalLabel. |
1671 self normalLabel. |
1662 ] |
1672 ] |
1663 ] |
1673 ] |
1664 |
1674 |
1665 "Created: 23.11.1995 / 11:41:38 / cg" |
1675 "Created: 23.11.1995 / 11:41:38 / cg" |
1666 "Modified: 9.12.1995 / 21:19:08 / cg" |
1676 "Modified: 9.12.1995 / 21:19:08 / cg" |
1667 ! |
1677 ! |
1669 classCompareWithNewestInRepository |
1679 classCompareWithNewestInRepository |
1670 "open a diff-textView comparing the current (in-image) version |
1680 "open a diff-textView comparing the current (in-image) version |
1671 with the most recent version found in the repository." |
1681 with the most recent version found in the repository." |
1672 |
1682 |
1673 currentClass isLoaded ifFalse:[ |
1683 currentClass isLoaded ifFalse:[ |
1674 self warn:'cannot compare unloaded classes.'. |
1684 self warn:'cannot compare unloaded classes.'. |
1675 ^ self. |
1685 ^ self. |
1676 ]. |
1686 ]. |
1677 |
1687 |
1678 self doClassMenu:[:currentClass | |
1688 self doClassMenu:[:currentClass | |
1679 |aStream comparedSource currentSource v rev revString mgr| |
1689 |aStream comparedSource currentSource v rev revString mgr| |
1680 |
1690 |
1681 mgr := currentClass sourceCodeManager. |
1691 mgr := currentClass sourceCodeManager. |
1682 |
1692 |
1683 rev := Dialog request:'compare to revision: (empty for newest)'. |
1693 rev := Dialog request:'compare to revision: (empty for newest)'. |
1684 rev notNil ifTrue:[ |
1694 rev notNil ifTrue:[ |
1685 rev withoutSpaces isEmpty ifTrue:[ |
1695 rev withoutSpaces isEmpty ifTrue:[ |
1686 self busyLabel:'extracting newest %1' with:currentClass name. |
1696 self busyLabel:'extracting newest %1' with:currentClass name. |
1687 aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name. |
1697 aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name. |
1688 revString := 'newest' |
1698 revString := 'newest' |
1689 ] ifFalse:[ |
1699 ] ifFalse:[ |
1690 self busyLabel:'extracting previous %1' with:currentClass name. |
1700 self busyLabel:'extracting previous %1' with:currentClass name. |
1691 aStream := mgr sourceStreamFor:currentClass revision:rev. |
1701 aStream := mgr sourceStreamFor:currentClass revision:rev. |
1692 revString := rev |
1702 revString := rev |
1693 ]. |
1703 ]. |
1694 aStream isNil ifTrue:[ |
1704 aStream isNil ifTrue:[ |
1695 self warn:'could not extract source from repository'. |
1705 self warn:'could not extract source from repository'. |
1696 ^ self |
1706 ^ self |
1697 ]. |
1707 ]. |
1698 comparedSource := aStream contents. |
1708 comparedSource := aStream contents. |
1699 aStream close. |
1709 aStream close. |
1700 |
1710 |
1701 self busyLabel:'generating current source ...' with:nil. |
1711 self busyLabel:'generating current source ...' with:nil. |
1702 |
1712 |
1703 aStream := '' writeStream. |
1713 aStream := '' writeStream. |
1704 currentClass fileOutOn:aStream withTimeStamp:false. |
1714 currentClass fileOutOn:aStream withTimeStamp:false. |
1705 currentSource := aStream contents. |
1715 currentSource := aStream contents. |
1706 aStream close. |
1716 aStream close. |
1707 |
1717 |
1708 self busyLabel:'comparing ...' with:nil. |
1718 self busyLabel:'comparing ...' with:nil. |
1709 v := DiffTextView |
1719 v := DiffTextView |
1710 openOn:currentSource label:'current (' , currentClass revision , ')' |
1720 openOn:currentSource label:'current (' , currentClass revision , ')' |
1711 and:comparedSource label:'repository (' , revString , ')'. |
1721 and:comparedSource label:'repository (' , revString , ')'. |
1712 v label:'comparing ' , currentClass name. |
1722 v label:'comparing ' , currentClass name. |
1713 self normalLabel. |
1723 self normalLabel. |
1714 ] |
1724 ] |
1715 ] |
1725 ] |
1716 |
1726 |
1717 "Created: 14.11.1995 / 16:43:15 / cg" |
1727 "Created: 14.11.1995 / 16:43:15 / cg" |
1718 "Modified: 9.12.1995 / 21:57:10 / cg" |
1728 "Modified: 9.12.1995 / 21:57:10 / cg" |
1719 ! |
1729 ! |
1748 |
1758 |
1749 "/ |
1759 "/ |
1750 "/ try to extract some useful defaults from the current project |
1760 "/ try to extract some useful defaults from the current project |
1751 "/ |
1761 "/ |
1752 (Project notNil and:[(project := Project current) notNil]) ifTrue:[ |
1762 (Project notNil and:[(project := Project current) notNil]) ifTrue:[ |
1753 (nm := project repositoryDirectory) isNil ifTrue:[ |
1763 (nm := project repositoryDirectory) isNil ifTrue:[ |
1754 nm := project name |
1764 nm := project name |
1755 ]. |
1765 ]. |
1756 packageHolder value:nm. |
1766 packageHolder value:nm. |
1757 |
1767 |
1758 (nm := project repositoryModule) notNil ifTrue:[ |
1768 (nm := project repositoryModule) notNil ifTrue:[ |
1759 moduleHolder value:nm |
1769 moduleHolder value:nm |
1760 ]. |
1770 ]. |
1761 ]. |
1771 ]. |
1762 |
1772 |
1763 "/ |
1773 "/ |
1764 "/ ask the sourceCodeManager if it knows anything about that class |
1774 "/ ask the sourceCodeManager if it knows anything about that class |
1765 "/ if so, take that as a default. |
1775 "/ if so, take that as a default. |
1766 "/ |
1776 "/ |
1767 info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass. |
1777 info := (mgr := aClass sourceCodeManager) sourceInfoOfClass:aClass. |
1768 info notNil ifTrue:[ |
1778 info notNil ifTrue:[ |
1769 (info includesKey:#module) ifTrue:[ |
1779 (info includesKey:#module) ifTrue:[ |
1770 moduleHolder value:(info at:#module). |
1780 moduleHolder value:(info at:#module). |
1771 ]. |
1781 ]. |
1772 (info includesKey:#directory) ifTrue:[ |
1782 (info includesKey:#directory) ifTrue:[ |
1773 packageHolder value:(info at:#directory). |
1783 packageHolder value:(info at:#directory). |
1774 ]. |
1784 ]. |
1775 (info includesKey:#expectedFileName) ifTrue:[ |
1785 (info includesKey:#expectedFileName) ifTrue:[ |
1776 fn := (info at:#expectedFileName). |
1786 fn := (info at:#expectedFileName). |
1777 ] ifFalse:[ |
1787 ] ifFalse:[ |
1778 (info includesKey:#classFileName) ifTrue:[ |
1788 (info includesKey:#classFileName) ifTrue:[ |
1779 fn := (info at:#classFileName). |
1789 fn := (info at:#classFileName). |
1780 ] |
1790 ] |
1781 ] |
1791 ] |
1782 ]. |
1792 ]. |
1783 |
1793 |
1784 fn isNil ifTrue:[ |
1794 fn isNil ifTrue:[ |
1785 fn := (Smalltalk fileNameForClass:aClass) , '.st'. |
1795 fn := (Smalltalk fileNameForClass:aClass) , '.st'. |
1786 ]. |
1796 ]. |
1787 |
1797 |
1788 fileNameHolder := fn asValue. |
1798 fileNameHolder := fn asValue. |
1789 |
1799 |
1790 "/ |
1800 "/ |
1829 box addAbortButton; addOkButton. |
1839 box addAbortButton; addOkButton. |
1830 |
1840 |
1831 box showAtPointer. |
1841 box showAtPointer. |
1832 |
1842 |
1833 box accepted ifTrue:[ |
1843 box accepted ifTrue:[ |
1834 aClass revisionString isNil ifTrue:[ |
1844 aClass revisionString isNil ifTrue:[ |
1835 (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs) |
1845 (self confirm:(resources string:'%1 does not have any revision info (#version method)\\Shall I create one ?' with:aClass name) withCRs) |
1836 ifFalse:[ |
1846 ifFalse:[ |
1837 ^ self |
1847 ^ self |
1838 ]. |
1848 ]. |
1839 aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass). |
1849 aClass updateVersionMethodFor:(mgr initialRevisionStringFor:aClass). |
1840 ]. |
1850 ]. |
1841 |
1851 |
1842 module := moduleHolder value withoutSpaces. |
1852 module := moduleHolder value withoutSpaces. |
1843 package := packageHolder value withoutSpaces. |
1853 package := packageHolder value withoutSpaces. |
1844 fileName := fileNameHolder value withoutSpaces. |
1854 fileName := fileNameHolder value withoutSpaces. |
1845 |
1855 |
1846 "/ |
1856 "/ |
1847 "/ check for the module |
1857 "/ check for the module |
1848 "/ |
1858 "/ |
1849 (mgr checkForExistingModule:module) ifFalse:[ |
1859 (mgr checkForExistingModule:module) ifFalse:[ |
1850 (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[ |
1860 (self confirm:(resources string:'%1 is a new module.\\create it ?' with:module) withCRs) ifFalse:[ |
1851 ^ self. |
1861 ^ self. |
1852 ]. |
1862 ]. |
1853 (mgr createModule:module) ifFalse:[ |
1863 (mgr createModule:module) ifFalse:[ |
1854 self warn:(resources string:'cannot create new module: %1' with:module). |
1864 self warn:(resources string:'cannot create new module: %1' with:module). |
1855 ^ self. |
1865 ^ self. |
1856 ] |
1866 ] |
1857 ]. |
1867 ]. |
1858 |
1868 |
1859 "/ |
1869 "/ |
1860 "/ check for the package |
1870 "/ check for the package |
1861 "/ |
1871 "/ |
1862 (mgr checkForExistingModule:module package:package) ifFalse:[ |
1872 (mgr checkForExistingModule:module package:package) ifFalse:[ |
1863 (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[ |
1873 (self confirm:(resources string:'%1 is a new package (in module %2).\\create it ?' with:package with:module) withCRs) ifFalse:[ |
1864 ^ self. |
1874 ^ self. |
1865 ]. |
1875 ]. |
1866 (mgr createModule:module package:package) ifFalse:[ |
1876 (mgr createModule:module package:package) ifFalse:[ |
1867 self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module). |
1877 self warn:(resources string:'cannot create new package: %1 (in module %2)' with:package with:module). |
1868 ^ self. |
1878 ^ self. |
1869 ] |
1879 ] |
1870 ]. |
1880 ]. |
1871 |
1881 |
1872 "/ |
1882 "/ |
1873 "/ check for the container itself |
1883 "/ check for the container itself |
1874 "/ |
1884 "/ |
1875 (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[ |
1885 (mgr checkForExistingContainerInModule:module package:package container:fileName) ifTrue:[ |
1876 self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs. |
1886 self warn:(resources string:'container for %1 already exists in %2/%3.\\You have to destroy the old one or use another name.' with:fileName with:module with:package) withCRs. |
1877 ^ self |
1887 ^ self |
1878 ]. |
1888 ]. |
1879 |
1889 |
1880 (mgr |
1890 (mgr |
1881 createContainerFor:aClass |
1891 createContainerFor:aClass |
1882 inModule:module |
1892 inModule:module |
1883 package:package |
1893 package:package |
1884 container:fileName) ifFalse:[ |
1894 container:fileName) ifFalse:[ |
1885 self warn:(resources string:'failed to create container.'). |
1895 self warn:(resources string:'failed to create container.'). |
1886 ^ self. |
1896 ^ self. |
1887 ]. |
1897 ]. |
1888 ]. |
1898 ]. |
1889 box destroy |
1899 box destroy |
1890 |
1900 |
1891 "Modified: 9.12.1995 / 21:51:54 / cg" |
1901 "Modified: 9.12.1995 / 21:51:54 / cg" |
1892 ! |
1902 ! |
1894 classLoadRevision |
1904 classLoadRevision |
1895 "load a specific revision into the system - especially useful to |
1905 "load a specific revision into the system - especially useful to |
1896 upgrade a class to the newest revision" |
1906 upgrade a class to the newest revision" |
1897 |
1907 |
1898 currentClass isLoaded ifFalse:[ |
1908 currentClass isLoaded ifFalse:[ |
1899 self warn:'cannot load specific releases of autoloaded classes.'. |
1909 self warn:'cannot load specific releases of autoloaded classes.'. |
1900 ^ self. |
1910 ^ self. |
1901 ]. |
1911 ]. |
1902 |
1912 |
1903 self doClassMenu:[:currentClass | |
1913 self doClassMenu:[:currentClass | |
1904 |aStream comparedSource currentSource v rev revString what mgr keep className |
1914 |aStream comparedSource currentSource v rev revString what mgr keep className |
1905 newClass| |
1915 newClass| |
1906 |
1916 |
1907 rev := Dialog request:'load which revision: (empty for newest)'. |
1917 rev := Dialog request:'load which revision: (empty for newest)'. |
1908 rev notNil ifTrue:[ |
1918 rev notNil ifTrue:[ |
1909 className := currentClass name. |
1919 className := currentClass name. |
1910 (className includesString:'_rev_') ifTrue:[ |
1920 (className includesString:'_rev_') ifTrue:[ |
1911 self warn:'select the original class and try again.'. |
1921 self warn:'select the original class and try again.'. |
1912 ^ self |
1922 ^ self |
1913 ]. |
1923 ]. |
1914 |
1924 |
1915 mgr := currentClass sourceCodeManager. |
1925 mgr := currentClass sourceCodeManager. |
1916 |
1926 |
1917 rev withoutSpaces isEmpty ifTrue:[ |
1927 rev withoutSpaces isEmpty ifTrue:[ |
1918 what := className , '(newest)'. |
1928 what := className , '(newest)'. |
1919 self busyLabel:'extracting %1' with:what. |
1929 self busyLabel:'extracting %1' with:what. |
1920 aStream := mgr mostRecentSourceStreamForClassNamed:className. |
1930 aStream := mgr mostRecentSourceStreamForClassNamed:className. |
1921 revString := 'newest'. |
1931 revString := 'newest'. |
1922 keep := false. |
1932 keep := false. |
1923 ] ifFalse:[ |
1933 ] ifFalse:[ |
1924 what := className , '(' , rev , ')'. |
1934 what := className , '(' , rev , ')'. |
1925 self busyLabel:'extracting %1' with:what. |
1935 self busyLabel:'extracting %1' with:what. |
1926 aStream := mgr sourceStreamFor:currentClass revision:rev. |
1936 aStream := mgr sourceStreamFor:currentClass revision:rev. |
1927 revString := rev. |
1937 revString := rev. |
1928 keep := true. |
1938 keep := true. |
1929 ]. |
1939 ]. |
1930 self busyLabel:'loading %1' with:what . |
1940 self busyLabel:'loading %1' with:what . |
1931 |
1941 |
1932 [ |
1942 [ |
1933 Class withoutUpdatingChangesDo:[ |
1943 Class withoutUpdatingChangesDo:[ |
1934 "/ rename the current class - for backup |
1944 "/ rename the current class - for backup |
1935 Smalltalk renameClass:currentClass to:className , '_saved'. |
1945 Smalltalk renameClass:currentClass to:className , '_saved'. |
1936 aStream fileIn. |
1946 aStream fileIn. |
1937 |
1947 |
1938 "/ did that work ? |
1948 "/ did that work ? |
1939 newClass := Smalltalk at:className ifAbsent:nil. |
1949 newClass := Smalltalk at:className ifAbsent:nil. |
1940 newClass isNil ifTrue:[ |
1950 newClass isNil ifTrue:[ |
1941 self warn:'fileIn failed - undoing changes ...'. |
1951 self warn:'fileIn failed - undoing changes ...'. |
1942 Smalltalk renameClass:currentClass to:className. |
1952 Smalltalk renameClass:currentClass to:className. |
1943 ] ifFalse:[ |
1953 ] ifFalse:[ |
1944 "/ |
1954 "/ |
1945 "/ if we loaded an old version, rename that one and fix the name of the |
1955 "/ if we loaded an old version, rename that one and fix the name of the |
1946 "/ current class |
1956 "/ current class |
1947 "/ |
1957 "/ |
1948 keep ifTrue:[ |
1958 keep ifTrue:[ |
1949 Smalltalk renameClass:newClass to:(className , '_rev_' , rev). |
1959 Smalltalk renameClass:newClass to:(className , '_rev_' , rev). |
1950 Smalltalk renameClass:currentClass to:className |
1960 Smalltalk renameClass:currentClass to:className |
1951 ] |
1961 ] |
1952 ] |
1962 ] |
1953 ]. |
1963 ]. |
1954 ] valueNowOrOnUnwindDo:[ |
1964 ] valueNowOrOnUnwindDo:[ |
1955 aStream close. |
1965 aStream close. |
1956 self normalLabel. |
1966 self normalLabel. |
1957 Smalltalk changed. |
1967 Smalltalk changed. |
1958 ]. |
1968 ]. |
1959 ] |
1969 ] |
1960 ] |
1970 ] |
1961 |
1971 |
1962 "Created: 14.11.1995 / 16:43:15 / cg" |
1972 "Created: 14.11.1995 / 16:43:15 / cg" |
1963 "Modified: 9.12.1995 / 22:32:04 / cg" |
1973 "Modified: 9.12.1995 / 22:32:04 / cg" |
1964 ! |
1974 ! |
1965 |
1975 |
1966 classRevisionInfo |
1976 classRevisionInfo |
1967 "show current classes revision info in codeView" |
1977 "show current classes revision info in codeView" |
1968 |
1978 |
1969 self doClassMenu:[:currentClass | |
1979 self doClassMenu:[:currentClass | |
1970 |aStream info info2 s rv mgr| |
1980 |aStream info info2 s rv mgr| |
1971 |
1981 |
1972 aStream := WriteStream on:(String new:200). |
1982 aStream := WriteStream on:(String new:200). |
1973 currentClass notNil ifTrue:[ |
1983 currentClass notNil ifTrue:[ |
1974 self busyLabel:'extracting revision info' with:nil. |
1984 self busyLabel:'extracting revision info' with:nil. |
1975 info := currentClass revisionInfo. |
1985 info := currentClass revisionInfo. |
1976 |
1986 |
1977 rv := currentClass binaryRevision. |
1987 rv := currentClass binaryRevision. |
1978 rv notNil ifTrue:[ |
1988 rv notNil ifTrue:[ |
1979 aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr. |
1989 aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr. |
1980 aStream nextPutAll:' Binary based upon : ' , rv; cr. |
1990 aStream nextPutAll:' Binary based upon : ' , rv; cr. |
1981 aStream cr. |
1991 aStream cr. |
1982 ]. |
1992 ]. |
1983 |
1993 |
1984 info notNil ifTrue:[ |
1994 info notNil ifTrue:[ |
1985 aStream nextPutAll:'**** Classes source information ****'; cr; cr. |
1995 aStream nextPutAll:'**** Classes source information ****'; cr; cr. |
1986 s := info at:#repositoryPath ifAbsent:nil. |
1996 s := info at:#repositoryPath ifAbsent:nil. |
1987 s notNil ifTrue:[ |
1997 s notNil ifTrue:[ |
1988 aStream nextPut:' Source repository : ' , s; cr |
1998 aStream nextPut:' Source repository : ' , s; cr |
1989 ]. |
1999 ]. |
1990 aStream nextPutAll:' Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr. |
2000 aStream nextPutAll:' Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr. |
1991 aStream nextPutAll:' Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr. |
2001 aStream nextPutAll:' Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr. |
1992 aStream nextPutAll:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr. |
2002 aStream nextPutAll:' Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr. |
1993 aStream nextPutAll:' Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr. |
2003 aStream nextPutAll:' Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr. |
1994 |
2004 |
1995 (info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[ |
2005 (info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[ |
1996 aStream nextPutAll:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr. |
2006 aStream nextPutAll:' Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr. |
1997 aStream nextPutAll:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr. |
2007 aStream nextPutAll:' Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr. |
1998 ]. |
2008 ]. |
1999 aStream nextPutAll:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr. |
2009 aStream nextPutAll:' Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr. |
2000 aStream cr. |
2010 aStream cr. |
2001 |
2011 |
2002 (mgr := currentClass sourceCodeManager) notNil ifTrue:[ |
2012 (mgr := currentClass sourceCodeManager) notNil ifTrue:[ |
2003 aStream nextPutAll:'**** Repository information ****'; cr; cr. |
2013 aStream nextPutAll:'**** Repository information ****'; cr; cr. |
2004 mgr writeRevisionLogOf:currentClass to:aStream. |
2014 mgr writeRevisionLogOf:currentClass to:aStream. |
2005 ] |
2015 ] |
2006 ] ifFalse:[ |
2016 ] ifFalse:[ |
2007 aStream nextPutAll:'No revision info found'; cr. |
2017 aStream nextPutAll:'No revision info found'; cr. |
2008 currentClass isLoaded ifFalse:[ |
2018 currentClass isLoaded ifFalse:[ |
2009 aStream cr; nextPutAll:'This is an autoloaded class - you may see more after its loaded.' |
2019 aStream cr; nextPutAll:'This is an autoloaded class - you may see more after its loaded.' |
2010 ] |
2020 ] |
2011 ] |
2021 ] |
2012 ]. |
2022 ]. |
2013 codeView contents:(aStream contents). |
2023 codeView contents:(aStream contents). |
2014 |
2024 |
2015 codeView modified:false. |
2025 codeView modified:false. |
2016 codeView acceptAction:nil. |
2026 codeView acceptAction:nil. |
2017 codeView explainAction:nil. |
2027 codeView explainAction:nil. |
2018 methodListView notNil ifTrue:[ |
2028 methodListView notNil ifTrue:[ |
2019 methodListView deselect |
2029 methodListView deselect |
2020 ]. |
2030 ]. |
2021 aspect := #revisionInfo. |
2031 aspect := #revisionInfo. |
2022 self normalLabel |
2032 self normalLabel |
2023 ] |
2033 ] |
2024 |
2034 |
2025 "Created: 14.11.1995 / 16:43:15 / cg" |
2035 "Created: 14.11.1995 / 16:43:15 / cg" |
2026 "Modified: 7.12.1995 / 23:54:04 / cg" |
2036 "Modified: 7.12.1995 / 23:54:04 / cg" |
2027 ! ! |
2037 ! ! |