author | Patrik Svestka <patrik.svestka@gmail.com> |
Wed, 17 Feb 2021 15:24:09 +0100 | |
branch | jv |
changeset 4568 | 524471ef6575 |
parent 4384 | e28fcaaf93c7 |
permissions | -rw-r--r-- |
2849 | 1 |
" |
2 |
COPYRIGHT (c) 2012 eXept Software AG |
|
3 |
All Rights Reserved |
|
4 |
||
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
12 |
"{ Package: 'stx:libbasic3' }" |
|
13 |
||
14 |
SourceCodeManagerUtilities subclass:#SourceCodeManagerUtilitiesForWorkspaceBasedManagers |
|
15 |
instanceVariableNames:'' |
|
16 |
classVariableNames:'' |
|
17 |
poolDictionaries:'' |
|
18 |
category:'System-SourceCodeManagement' |
|
19 |
! |
|
20 |
||
21 |
!SourceCodeManagerUtilitiesForWorkspaceBasedManagers class methodsFor:'documentation'! |
|
22 |
||
23 |
copyright |
|
24 |
" |
|
25 |
COPYRIGHT (c) 2012 eXept Software AG |
|
26 |
All Rights Reserved |
|
27 |
||
28 |
This software is furnished under a license and may be used |
|
29 |
only in accordance with the terms of that license and with the |
|
30 |
inclusion of the above copyright notice. This software may not |
|
31 |
be provided or otherwise made available to, or used by, any |
|
32 |
other person. No title to or ownership of the software is |
|
33 |
hereby transferred. |
|
34 |
" |
|
35 |
! ! |
|
36 |
||
37 |
!SourceCodeManagerUtilitiesForWorkspaceBasedManagers methodsFor:'utilities-cvs'! |
|
38 |
||
39 |
checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages |
|
40 |
|mgr classesToCheckIn methodsToCheckIn |
|
41 |
methodsInOtherPackages looseMethods otherPackages |
|
42 |
msg classesInChangeSet checkinInfo repos pkgDir extensionsSource defClass |
|
43 |
path fileIsNew| |
|
44 |
||
45 |
mgr := self sourceCodeManagerFor: packageToCheckIn. |
|
46 |
||
47 |
repos := (mgr repositoryNameForPackage:packageToCheckIn) ifNil:[mgr repositoryName]. |
|
48 |
||
2917
9efb40fbb7e9
changed: #checkinPackage:classes:extensions:buildSupport:askForMethodsInOtherPackages:
Claus Gittinger <cg@exept.de>
parents:
2905
diff
changeset
|
49 |
pkgDir := packageToCheckIn asPackageId pathRelativeToTopDirectory:(mgr workDirectory). |
2849 | 50 |
pkgDir recursiveMakeDirectory. |
51 |
||
52 |
"/ containerFileName := self nameOfExtensionsContainer. |
|
53 |
||
54 |
methodsToCheckIn := IdentitySet new. |
|
55 |
methodsInOtherPackages := IdentitySet new. |
|
56 |
looseMethods := IdentitySet new. |
|
57 |
||
58 |
classesToCheckIn := Smalltalk allClassesInPackage: packageToCheckIn. |
|
59 |
||
60 |
"/ cg: O(n^2) algorithm |
|
61 |
"/ classesInChangeSet := classesToCheckIn select:[:cls | cls hasUnsavedChanges]. |
|
62 |
"/ replaced by: O(n) algorithm |
|
2905 | 63 |
classesInChangeSet := ChangeSet current selectClassesForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classesToCheckIn. |
2849 | 64 |
|
65 |
"/ individual methods ... |
|
66 |
Smalltalk allClassesDo:[:aClass | |
|
67 |
aClass isMeta ifFalse:[ |
|
68 |
methodsToCheckIn addAll:(aClass extensionsFrom:packageToCheckIn). |
|
69 |
]. |
|
70 |
]. |
|
71 |
||
72 |
self assert:doExtensions. |
|
73 |
self assert:doClasses. |
|
74 |
self assert:doBuild. |
|
75 |
||
76 |
msg := '%1 classes (%4 changed) '. |
|
77 |
methodsToCheckIn notEmpty ifTrue:[ |
|
78 |
msg := msg , 'and %2 extensions '. |
|
79 |
]. |
|
80 |
msg := msg , 'of project "%3"'. |
|
81 |
||
82 |
checkinInfo := self |
|
83 |
getCheckinInfoFor:(msg |
|
84 |
bindWith:classesToCheckIn size |
|
85 |
with:methodsToCheckIn size |
|
86 |
with:packageToCheckIn allBold |
|
87 |
with:classesInChangeSet size) |
|
88 |
initialAnswer:nil |
|
3142
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
89 |
withQuickOption:false |
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
90 |
withValidateConsistencyOption:true. |
2849 | 91 |
checkinInfo isNil ifTrue:[ |
92 |
^ self. |
|
93 |
]. |
|
94 |
||
3142
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
95 |
checkinInfo validateConsistency ifTrue:[ |
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
96 |
self validateConsistencyOfPackage:packageToCheckIn. |
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
97 |
]. |
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
98 |
|
2849 | 99 |
"/ check if any of the classes contains methods for other packages ... |
100 |
classesToCheckIn do:[:eachClass | |
|
101 |
eachClass instAndClassMethodsDo:[:eachMethod | |
|
102 |
|mPgk| |
|
103 |
||
104 |
mPgk := eachMethod package. |
|
105 |
(mPgk = packageToCheckIn) ifFalse:[ |
|
106 |
mPgk == PackageId noProjectID ifTrue:[ |
|
107 |
looseMethods add:eachMethod |
|
108 |
] ifFalse:[ |
|
109 |
methodsInOtherPackages add:eachMethod |
|
110 |
] |
|
111 |
] |
|
112 |
]. |
|
113 |
]. |
|
114 |
||
115 |
askForMethodsInOtherPackages ifTrue:[ |
|
116 |
methodsInOtherPackages notEmpty ifTrue:[ |
|
117 |
otherPackages := Set new. |
|
118 |
methodsInOtherPackages do:[:eachMethod | otherPackages add:eachMethod package]. |
|
119 |
||
120 |
methodsInOtherPackages size == 1 ifTrue:[ |
|
121 |
msg := 'The ''%4'' method in ''%5'' is contained in the ''%2'' package.'. |
|
122 |
msg := msg , '\\This method will remain in its package.'. |
|
123 |
] ifFalse:[ |
|
124 |
otherPackages size == 1 ifTrue:[ |
|
125 |
msg := 'The %1 methods from the %2 package will remain in its package.' |
|
126 |
] ifFalse:[ |
|
127 |
msg := 'The %1 methods from %3 other packages will remain in their packages.' |
|
128 |
]. |
|
129 |
msg := msg , '\\Hint: if these are meant to belong to this package,'. |
|
130 |
msg := msg , '\move them first, then repeat the checkin operation.'. |
|
131 |
]. |
|
132 |
msg := msg withCRs. |
|
133 |
msg := msg bindWith:methodsInOtherPackages size |
|
134 |
with:otherPackages first allBold |
|
135 |
with:otherPackages size |
|
136 |
with:methodsInOtherPackages first selector allBold |
|
137 |
with:methodsInOtherPackages first mclass name allBold. |
|
138 |
(Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self]. |
|
139 |
]. |
|
140 |
]. |
|
141 |
||
142 |
classesToCheckIn notEmpty ifTrue:[ |
|
143 |
looseMethods notEmpty ifTrue:[ |
|
144 |
looseMethods size == 1 ifTrue:[ |
|
145 |
msg := 'The ''%2'' method in ''%3'' is unassigned (loose).'. |
|
146 |
msg := msg , '\\If you proceed, this method will be moved to the ''%4'' package'. |
|
147 |
msg := msg , '\\Hint: if this is meant to be an extension of another package,'. |
|
148 |
msg := msg , '\cancel and move it to the appropriate package first.'. |
|
149 |
] ifFalse:[ |
|
150 |
msg := 'There are %1 unassigned (loose) methods in classes from this project.'. |
|
151 |
msg := msg , '\\If you proceed, those will be moved to the ''%4'' package ?'. |
|
152 |
msg := msg , '\\Hint: if these are meant to be extensions of another package,'. |
|
153 |
msg := msg , '\cancel and move them to the appropriate package first.'. |
|
154 |
]. |
|
155 |
msg := msg withCRs. |
|
156 |
msg := msg bindWith:looseMethods size |
|
157 |
with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first selector allBold]) |
|
158 |
with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first mclass name allBold]) |
|
159 |
with:packageToCheckIn allBold. |
|
160 |
(Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self]. |
|
161 |
||
162 |
looseMethods do:[:mthd | |
|
163 |
mthd package:packageToCheckIn |
|
164 |
]. |
|
165 |
]. |
|
166 |
||
167 |
classesToCheckIn do:[:eachClass | |
|
168 |
|classFileName| |
|
169 |
||
170 |
classFileName := (Smalltalk fileNameForClass:eachClass) , '.st'. |
|
171 |
mgr |
|
172 |
withClass:eachClass |
|
173 |
classFileName:classFileName |
|
174 |
filedOutToTemporaryFileDo:[:tempFile | |
|
175 |
path := pkgDir construct:classFileName. |
|
176 |
fileIsNew := path exists not. |
|
177 |
tempFile moveTo:path. |
|
178 |
fileIsNew ifTrue:[ |
|
179 |
mgr addFile:path baseName inDirectory:path directory. |
|
180 |
]. |
|
181 |
]. |
|
182 |
]. |
|
183 |
]. |
|
184 |
||
185 |
path := pkgDir construct:self nameOfExtensionsContainer. |
|
186 |
methodsToCheckIn notEmpty ifTrue:[ |
|
187 |
extensionsSource := self sourceCodeForExtensions:methodsToCheckIn package:packageToCheckIn forManager:mgr. |
|
3132 | 188 |
"Care for non-ASCII/non-ISO-8859 characters in extension methods" |
189 |
extensionsSource isWideString ifTrue:[ |
|
190 |
extensionsSource := '"{ Encoding: utf8 }"' , Character cr asString , Character cr asString , extensionsSource. |
|
191 |
extensionsSource := extensionsSource utf8Encoded. |
|
192 |
]. |
|
2849 | 193 |
fileIsNew := path exists not. |
194 |
path contents:extensionsSource. |
|
195 |
fileIsNew ifTrue:[ |
|
196 |
mgr addFile:path baseName inDirectory:path directory. |
|
197 |
]. |
|
198 |
] ifFalse:[ |
|
199 |
"/ there may have been extension-methods previously - if so, remove them |
|
200 |
path remove |
|
201 |
]. |
|
202 |
||
203 |
defClass := ProjectDefinition definitionClassForPackage: packageToCheckIn. |
|
204 |
defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents | |
|
205 |
path := pkgDir construct:fileName. |
|
206 |
fileIsNew := path exists not. |
|
207 |
path directory exists ifFalse:[ |
|
208 |
path directory recursiveMakeDirectory. "/ for autopackage |
|
209 |
mgr addFile:path directory baseName inDirectory:path directory directory. |
|
210 |
]. |
|
211 |
path contents:fileContents. |
|
212 |
fileIsNew ifTrue:[ |
|
213 |
mgr addFile:fileName inDirectory:path directory. |
|
214 |
]. |
|
215 |
]. |
|
216 |
||
217 |
mgr commitRepository:repos logMessage:checkinInfo logMessage. |
|
218 |
||
219 |
"Created: / 13-10-2011 / 11:15:22 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
2917
9efb40fbb7e9
changed: #checkinPackage:classes:extensions:buildSupport:askForMethodsInOtherPackages:
Claus Gittinger <cg@exept.de>
parents:
2905
diff
changeset
|
220 |
"Modified: / 24-09-2012 / 11:13:04 / cg" |
2849 | 221 |
! ! |
222 |
||
223 |
!SourceCodeManagerUtilitiesForWorkspaceBasedManagers class methodsFor:'documentation'! |
|
224 |
||
225 |
version |
|
3142
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
226 |
^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilitiesForWorkspaceBasedManagers.st,v 1.5 2013-03-27 12:02:47 cg Exp $' |
2849 | 227 |
! |
228 |
||
229 |
version_CVS |
|
3142
c84a79e49811
class: SourceCodeManagerUtilitiesForWorkspaceBasedManagers
Claus Gittinger <cg@exept.de>
parents:
3132
diff
changeset
|
230 |
^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilitiesForWorkspaceBasedManagers.st,v 1.5 2013-03-27 12:02:47 cg Exp $' |
3067
580931ccfea6
fixed bug in changeset reading (info changes were lost)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3065
diff
changeset
|
231 |
! |
580931ccfea6
fixed bug in changeset reading (info changes were lost)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3065
diff
changeset
|
232 |
|
3243
292f55bcd8f0
Fixes in ChangeSet::ClassSourceWriter.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3158
diff
changeset
|
233 |
version_HG |
292f55bcd8f0
Fixes in ChangeSet::ClassSourceWriter.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3158
diff
changeset
|
234 |
|
292f55bcd8f0
Fixes in ChangeSet::ClassSourceWriter.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3158
diff
changeset
|
235 |
^ '$Changeset: <not expanded> $' |
292f55bcd8f0
Fixes in ChangeSet::ClassSourceWriter.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3158
diff
changeset
|
236 |
! |
292f55bcd8f0
Fixes in ChangeSet::ClassSourceWriter.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3158
diff
changeset
|
237 |
|
3067
580931ccfea6
fixed bug in changeset reading (info changes were lost)
Jan Vrany <jan.vrany@fit.cvut.cz>
parents:
3065
diff
changeset
|
238 |
version_SVN |
4384
e28fcaaf93c7
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present
Patrik Svestka <patrik.svestka@gmail.com>
parents:
3243
diff
changeset
|
239 |
^ '§Id:: SourceCodeManagerUtilitiesForWorkspaceBasedManagers.st 1971 2012-09-27 19:37:25Z vranyj1 §' |
2849 | 240 |
! ! |
3132 | 241 |