94 ProjectList open |
100 ProjectList open |
95 " |
101 " |
96 |
102 |
97 <resource: #canvas> |
103 <resource: #canvas> |
98 |
104 |
99 ^ |
105 ^ |
100 #(#FullSpec |
106 #(#FullSpec |
101 #name: #windowSpec |
107 #name: #windowSpec |
102 #window: |
108 #window: |
103 #(#WindowSpec |
109 #(#WindowSpec |
104 #label: 'ProjectList' |
110 #label: 'ProjectList' |
105 #name: 'ProjectList' |
111 #name: 'ProjectList' |
106 #min: #(#Point 0 0) |
112 #min: #(#Point 0 0) |
107 #bounds: #(#Rectangle 13 23 313 323) |
113 #bounds: #(#Rectangle 13 23 313 323) |
108 ) |
114 ) |
109 #component: |
115 #component: |
110 #(#SpecCollection |
116 #(#SpecCollection |
111 #collection: #( |
117 #collection: #( |
112 #(#SequenceViewSpec |
118 #(#SequenceViewSpec |
113 #name: 'List' |
119 #name: 'List' |
114 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) |
120 #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) |
115 #tabable: true |
121 #tabable: true |
116 #model: #selectionIndexHolder |
122 #model: #selectionIndexHolder |
117 #menu: #menuHolder |
123 #menu: #menuHolder |
118 #hasHorizontalScrollBar: true |
124 #hasHorizontalScrollBar: true |
119 #hasVerticalScrollBar: true |
125 #hasVerticalScrollBar: true |
120 #miniScrollerHorizontal: true |
126 #miniScrollerHorizontal: true |
121 #isMultiSelect: true |
127 #isMultiSelect: true |
122 #valueChangeSelector: #selectionChangedByClick |
128 #valueChangeSelector: #selectionChangedByClick |
123 #useIndex: true |
129 #useIndex: true |
124 #sequenceList: #projectNameList |
130 #sequenceList: #projectNameList |
125 #doubleClickChannel: #doubleClickChannel |
131 #doubleClickChannel: #doubleClickChannel |
126 #properties: |
132 #properties: |
127 #(#PropertyListDictionary |
133 #(#PropertyListDictionary |
128 #dragArgument: nil |
134 #dragArgument: nil |
129 #dropArgument: nil |
135 #dropArgument: nil |
130 #canDropSelector: #canDropContext: |
136 #canDropSelector: #canDropContext: |
131 #dropSelector: #doDropContext: |
137 #dropSelector: #doDropContext: |
132 ) |
138 ) |
133 ) |
139 ) |
134 ) |
140 ) |
135 |
141 |
136 ) |
142 ) |
137 ) |
143 ) |
138 |
144 |
139 "Created: / 17.2.2000 / 23:45:47 / cg" |
145 "Created: / 17.2.2000 / 23:45:47 / cg" |
140 "Modified: / 17.2.2000 / 23:47:53 / cg" |
146 "Modified: / 17.2.2000 / 23:47:53 / cg" |
141 ! ! |
147 ! ! |
142 |
148 |
143 !ProjectList class methodsFor:'queries-plugin'! |
149 !ProjectList class methodsFor:'queries-plugin'! |
144 |
150 |
145 aspectSelectors |
151 aspectSelectors |
146 ^ #( |
152 ^ #( |
147 #(#doubleClickChannel #action ) |
153 #(#doubleClickChannel #action ) |
148 immediateUpdate |
154 immediateUpdate |
149 selectedProjects |
155 selectedProjects |
150 menuHolder |
156 menuHolder |
151 outGeneratorHolder |
157 outGeneratorHolder |
152 inGeneratorHolder |
158 inGeneratorHolder |
153 selectionChangeCondition |
159 selectionChangeCondition |
154 updateTrigger |
160 updateTrigger |
155 forceGeneratorTrigger |
161 forceGeneratorTrigger |
156 hideUnloadedClasses |
162 hideUnloadedClasses |
157 organizerMode |
163 organizerMode |
215 !ProjectList methodsFor:'change & update'! |
227 !ProjectList methodsFor:'change & update'! |
216 |
228 |
217 delayedUpdate:something with:aParameter from:changedObject |
229 delayedUpdate:something with:aParameter from:changedObject |
218 |cls sel pkg mthd newSel allIdx| |
230 |cls sel pkg mthd newSel allIdx| |
219 |
231 |
220 self inSlaveModeOrInvisible |
232 self inSlaveModeOrInvisible |
221 "/ (self slaveMode value == true) |
233 "/ (self slaveMode value == true) |
222 ifTrue:[ |
234 ifTrue:[ |
223 (changedObject == Smalltalk |
235 (changedObject == Smalltalk |
224 or:[ something == #projectOrganization ]) ifTrue:[ |
236 or:[ something == #projectOrganization ]) ifTrue:[ |
225 listValid := false |
237 listValid := false |
226 ]. |
238 ]. |
227 ^ self |
239 ^ self |
228 ]. |
240 ]. |
229 |
241 |
230 changedObject == self selectionIndexHolder ifTrue:[ |
242 changedObject == self selectionIndexHolder ifTrue:[ |
231 listValid ifFalse:[ |
243 listValid ifFalse:[ |
232 self updateList. |
244 self updateList. |
233 ]. |
245 ]. |
234 newSel := changedObject value collect:[:idx | projectList value at:idx]. |
246 newSel := changedObject value collect:[:idx | projectList value at:idx]. |
235 newSel ~= self selectedProjects value ifTrue:[ |
247 newSel ~= self selectedProjects value ifTrue:[ |
236 self selectedProjects value:newSel. |
248 self selectedProjects value:newSel. |
237 ]. |
249 ]. |
238 ^ self. |
250 ^ self. |
239 ]. |
251 ]. |
240 changedObject == self selectionHolder ifTrue:[ |
252 changedObject == self selectionHolder ifTrue:[ |
241 listValid == true ifFalse:[ |
253 listValid ifFalse:[ |
242 self updateList. |
254 self updateList. |
243 ]. |
255 ]. |
244 allIdx := projectList value indexOf:(self class nameListEntryForALL). |
256 allIdx := projectList value indexOf:(self class nameListEntryForALL). |
245 newSel := changedObject value |
257 newSel := changedObject value |
246 collect:[:val | |i| |
258 collect:[:val | |i| |
247 i := projectList value indexOf:val. |
259 i := projectList value indexOf:val. |
248 i == 0 ifTrue:[allIdx] ifFalse:[i]] |
260 i == 0 ifTrue:[allIdx] ifFalse:[i]] |
249 thenSelect:[:idx | idx ~~ 0]. |
261 thenSelect:[:idx | idx ~~ 0]. |
250 newSel ~= self selectionIndexHolder value ifTrue:[ |
262 newSel ~= self selectionIndexHolder value ifTrue:[ |
251 self selectionIndexHolder value:newSel |
263 self selectionIndexHolder value:newSel |
252 ]. |
264 ]. |
253 ]. |
265 ]. |
254 |
266 |
255 changedObject == slaveMode ifTrue:[ |
267 changedObject == slaveMode ifTrue:[ |
256 listValid ~~ true ifTrue:[ |
268 listValid ~~ true ifTrue:[ |
257 self enqueueDelayedUpdateList |
269 self enqueueDelayedUpdateList |
258 ]. |
270 ]. |
259 "/ self invalidateList. |
271 "/ self invalidateList. |
260 ^ self |
272 ^ self |
261 ]. |
273 ]. |
262 |
274 |
263 changedObject == self projectList ifTrue:[ |
275 changedObject == self projectList ifTrue:[ |
264 ^ self |
276 ^ self |
265 ]. |
277 ]. |
266 |
278 |
267 changedObject == Smalltalk ifTrue:[ |
279 changedObject == Smalltalk ifTrue:[ |
268 something == #projectOrganization ifTrue:[ |
280 something == #projectOrganization ifTrue:[ |
269 self invalidateList. |
281 self invalidateList. |
270 self enqueueDelayedUpdateOutputGenerator. |
282 self enqueueDelayedUpdateOutputGenerator. |
271 ^ self. |
283 ^ self. |
272 ]. |
284 ]. |
273 something == #methodInClass ifTrue:[ |
285 something == #methodInClass ifTrue:[ |
274 listValid == true ifTrue:[ |
286 listValid == true ifTrue:[ |
275 cls := aParameter at:1. |
287 cls := aParameter at:1. |
276 sel := aParameter at:2. |
288 sel := aParameter at:2. |
277 mthd := cls compiledMethodAt:sel. |
289 mthd := cls compiledMethodAt:sel. |
278 mthd notNil ifTrue:[ |
290 mthd notNil ifTrue:[ |
279 pkg := mthd package. |
291 pkg := mthd package. |
280 (projectList value includes:pkg) ifFalse:[ |
292 (projectList value includes:pkg) ifFalse:[ |
281 self invalidateList. |
293 self invalidateList. |
282 ] |
294 ] |
283 ]. |
295 ]. |
284 ]. |
296 ]. |
285 ^ self |
297 ^ self |
286 ]. |
298 ]. |
287 |
299 |
288 (something == #classDefinition |
300 (something == #classDefinition |
289 or:[something == #newClass]) ifTrue:[ |
301 or:[something == #newClass]) ifTrue:[ |
290 listValid == true ifTrue:[ |
302 listValid == true ifTrue:[ |
291 cls := aParameter. |
303 cls := aParameter. |
292 pkg := cls package. |
304 pkg := cls package. |
293 (projectList value includes:pkg) ifFalse:[ |
305 (projectList value includes:pkg) ifFalse:[ |
294 self invalidateList. |
306 self invalidateList. |
295 ] ifTrue:[ |
307 ] ifTrue:[ |
296 self enqueueDelayedUpdateOutputGenerator |
308 self enqueueDelayedUpdateOutputGenerator |
297 ]. |
309 ]. |
298 ] ifFalse:[ |
310 ] ifFalse:[ |
299 self invalidateList |
311 self invalidateList |
300 ]. |
312 ]. |
301 ^ self |
313 ^ self |
302 ]. |
314 ]. |
303 (something == #classRemove) ifTrue:[ |
315 (something == #classRemove) ifTrue:[ |
304 listValid == true ifTrue:[ |
316 listValid == true ifTrue:[ |
305 cls := aParameter. |
317 cls := aParameter. |
306 pkg := cls package. |
318 pkg := cls package. |
307 ]. |
319 ]. |
308 ]. |
320 ]. |
309 ^ self |
321 ^ self |
310 ]. |
322 ]. |
311 |
323 |
312 "/ something == #projectOrganization ifTrue:[ |
324 "/ something == #projectOrganization ifTrue:[ |
313 "/ aParameter isSymbol ifTrue:[ |
325 "/ aParameter isSymbol ifTrue:[ |
314 "/ "/ a single method has changed |
326 "/ "/ a single method has changed |
341 |
353 |
342 "Created: / 17.2.2000 / 23:41:17 / cg" |
354 "Created: / 17.2.2000 / 23:41:17 / cg" |
343 ! |
355 ! |
344 |
356 |
345 update:something with:aParameter from:changedObject |
357 update:something with:aParameter from:changedObject |
346 | ts | |
|
347 |
|
348 |
358 |
349 (self builder isNil or:[self window topView realized not]) ifTrue:[ |
359 (self builder isNil or:[self window topView realized not]) ifTrue:[ |
350 self makeIndependent |
360 self makeIndependent |
351 ]. |
361 ]. |
352 |
362 |
353 changedObject == Smalltalk ifTrue:[ |
363 changedObject == Smalltalk ifTrue:[ |
354 "/ JV@2012-10-03: Rubbish |
364 something == #methodDictionary ifTrue:[ |
355 "/ |
365 ^ self |
356 "/ "JV2012-02-17: Suppress updates if they're comming too fast |
366 ]. |
357 "/ (such as when booting Java or so)" |
367 something == #methodTrap ifTrue:[ |
358 "/ ts := OperatingSystem getMillisecondTime. |
368 ^ self |
359 "/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[ |
369 ]. |
360 "/ lastUpdateFromSmalltalkTimestamp := ts. |
370 something == #methodCoverageInfo ifTrue:[ |
361 "/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1. |
371 ^ self |
362 "/ numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ]. |
372 ]. |
363 "/ |
373 something == #methodInClass ifTrue:[ |
364 "/ ]. |
374 ^ self |
365 "/ numUpdatesFromSmalltalkInLast200Msecs := 0. |
375 ]. |
366 "/ lastUpdateFromSmalltalkTimestamp := ts. |
376 something == #classVariables ifTrue:[ |
367 |
377 ^ self |
368 something == #methodDictionary ifTrue:[ |
378 ]. |
369 ^ self |
379 something == #classComment ifTrue:[ |
370 ]. |
380 ^ self. |
371 something == #methodTrap ifTrue:[ |
381 ]. |
372 ^ self |
382 something == #methodInClassRemoved ifTrue:[ |
373 ]. |
383 ^ self. |
374 something == #methodCoverageInfo ifTrue:[ |
384 ]. |
375 ^ self |
|
376 ]. |
|
377 something == #methodInClass ifTrue:[ |
|
378 ^ self |
|
379 ]. |
|
380 something == #classVariables ifTrue:[ |
|
381 ^ self |
|
382 ]. |
|
383 something == #classComment ifTrue:[ |
|
384 ^ self. |
|
385 ]. |
|
386 something == #methodInClassRemoved ifTrue:[ |
|
387 ^ self. |
|
388 ]. |
|
389 ]. |
385 ]. |
390 super update:something with:aParameter from:changedObject |
386 super update:something with:aParameter from:changedObject |
391 |
387 |
392 "Modified: / 20-07-2011 / 18:54:39 / cg" |
388 "Modified: / 20-07-2011 / 18:54:39 / cg" |
393 "Modified: / 18-02-2012 / 21:58:42 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
394 ! ! |
389 ! ! |
395 |
390 |
396 !ProjectList methodsFor:'drag & drop'! |
391 !ProjectList methodsFor:'drag & drop'! |
397 |
392 |
398 canDropContext:aDropContext |
393 canDropContext:aDropContext |
416 doDropContext:aDropContext |
411 doDropContext:aDropContext |
417 |package objects methods classes| |
412 |package objects methods classes| |
418 |
413 |
419 objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject]. |
414 objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject]. |
420 (objects conform:[:something | (something isMethod or:[something isClass])]) ifTrue:[ |
415 (objects conform:[:something | (something isMethod or:[something isClass])]) ifTrue:[ |
421 methods := objects select:[:something | something isMethod]. |
416 methods := objects select:[:something | something isMethod]. |
422 classes := objects select:[:something | something isClass]. |
417 classes := objects select:[:something | something isClass]. |
423 |
418 |
424 package := self packageAtTargetPointOf:aDropContext. |
419 package := self packageAtTargetPointOf:aDropContext. |
425 package notNil ifTrue:[ |
420 package notNil ifTrue:[ |
426 methods notEmpty ifTrue:[ |
421 methods notEmpty ifTrue:[ |
427 self masterApplication moveMethods:methods toProject:package. |
422 self masterApplication moveMethods:methods toProject:package. |
428 ]. |
423 ]. |
429 classes notEmpty ifTrue:[ |
424 classes notEmpty ifTrue:[ |
430 self masterApplication moveClasses:classes toProject:package. |
425 self masterApplication moveClasses:classes toProject:package. |
431 ] |
426 ] |
432 ]. |
427 ]. |
433 ^ self |
428 ^ self |
434 ]. |
429 ]. |
435 |
430 |
436 (objects conform:[:something | something isFilename]) ifTrue:[ |
431 (objects conform:[:something | something isFilename]) ifTrue:[ |
437 |p| |
432 |p| |
438 |
433 |
439 p := (self selectedProjects value ? #()) firstIfEmpty:PackageId noProjectID. |
434 p := (self selectedProjects value ? #()) firstIfEmpty:PackageId noProjectID. |
440 |
435 |
441 Class packageQuerySignal answer:p |
436 Class packageQuerySignal answer:p |
442 do:[ |
437 do:[ |
443 self dropClassFiles:objects. |
438 self dropClassFiles:objects. |
444 ]. |
439 ]. |
445 ^ self |
440 ^ self |
446 ]. |
441 ]. |
447 |
442 |
448 "Modified: / 17-10-2006 / 18:34:43 / cg" |
443 "Modified: / 17-10-2006 / 18:34:43 / cg" |
449 ! |
444 ! |
450 |
445 |
451 packageAtTargetPointOf:aDropContext |
446 packageAtTargetPointOf:aDropContext |
452 |p packageListView lineNr item package dropInfo now |
447 |p packageListView lineNr item package dropInfo now |
453 overItem timeOverItem| |
448 overItem timeOverItem| |
454 |
449 |
455 p := aDropContext targetPoint. |
450 p := aDropContext targetPoint. |
456 |
451 |
457 packageListView := aDropContext targetWidget. |
452 packageListView := aDropContext targetWidget. |
464 item := projectList value at:lineNr. |
459 item := projectList value at:lineNr. |
465 item isNil ifTrue:[^ nil]. |
460 item isNil ifTrue:[^ nil]. |
466 item isString ifTrue:[^ item asSymbol]. |
461 item isString ifTrue:[^ item asSymbol]. |
467 |
462 |
468 item canExpand ifTrue:[ |
463 item canExpand ifTrue:[ |
469 now := Timestamp now. |
464 now := Timestamp now. |
470 overItem := dropInfo at:#overItem ifAbsentPut:item. |
465 overItem := dropInfo at:#overItem ifAbsentPut:item. |
471 timeOverItem := dropInfo at:#timeOverItem ifAbsentPut:[now]. |
466 timeOverItem := dropInfo at:#timeOverItem ifAbsentPut:[now]. |
472 |
467 |
473 overItem ~~ item ifTrue:[ |
468 overItem ~~ item ifTrue:[ |
474 dropInfo at:#timeOverItem put:now. |
469 dropInfo at:#timeOverItem put:now. |
475 dropInfo at:#overItem put:item. |
470 dropInfo at:#overItem put:item. |
476 aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ]. |
471 aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ]. |
477 ] ifFalse:[ |
472 ] ifFalse:[ |
478 (now millisecondDeltaFrom:timeOverItem) >= (UserPreferences current timeToAutoExpandItemsWhenDraggingOver) ifTrue:[ |
473 (now millisecondDeltaFrom:timeOverItem) >= (UserPreferences current timeToAutoExpandItemsWhenDraggingOver) ifTrue:[ |
479 aDropContext saveDraw:[ item expand. packageListView repairDamage ]. |
474 aDropContext saveDraw:[ item expand. packageListView repairDamage ]. |
480 dropInfo removeKey:#timeOverItem. |
475 dropInfo removeKey:#timeOverItem. |
481 dropInfo removeKey:#overItem. |
476 dropInfo removeKey:#overItem. |
482 ] ifFalse:[ |
477 ] ifFalse:[ |
483 aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ]. |
478 aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ]. |
484 ] |
479 ] |
485 ]. |
480 ]. |
486 ]. |
481 ]. |
487 |
482 |
488 package := item package. |
483 package := item package. |
489 package = self class nameListEntryForALL ifTrue:[^ nil]. |
484 package = self class nameListEntryForALL ifTrue:[^ nil]. |
490 ^ package. |
485 ^ package. |
499 |
494 |
500 |selectedPackages thePackage hideUnloadedClasses showChangedClasses| |
495 |selectedPackages thePackage hideUnloadedClasses showChangedClasses| |
501 |
496 |
502 selectedPackages := self selectedProjects value. |
497 selectedPackages := self selectedProjects value. |
503 selectedPackages size == 0 ifTrue:[ |
498 selectedPackages size == 0 ifTrue:[ |
504 ^ #() |
499 ^ #() |
505 ]. |
500 ]. |
506 selectedPackages := selectedPackages collect:[:p | p string withoutSeparators]. |
501 selectedPackages := selectedPackages collect:[:p | p string withoutSeparators]. |
507 |
502 |
508 showChangedClasses := selectedPackages includes:(self class nameListEntryForChanged). |
503 showChangedClasses := selectedPackages includes:(self class nameListEntryForChanged). |
509 hideUnloadedClasses := self hideUnloadedClasses value. |
504 hideUnloadedClasses := self hideUnloadedClasses value. |
510 |
505 |
511 (selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[ |
506 (selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[ |
512 hideUnloadedClasses ifTrue:[ |
507 hideUnloadedClasses ifTrue:[ |
513 ^ Iterator on:[:whatToDo | |
508 ^ Iterator on:[:whatToDo | |
514 Smalltalk allClassesDo:[:cls | |
509 Smalltalk allClassesDo:[:cls | |
515 cls isLoaded ifTrue:[ |
510 cls isLoaded ifTrue:[ |
516 cls isRealNameSpace ifFalse:[ |
511 cls isRealNameSpace ifFalse:[ |
517 whatToDo value:cls |
512 whatToDo value:cls |
518 ] |
513 ] |
519 ] |
514 ] |
520 ] |
515 ] |
521 ] |
516 ] |
522 ]. |
517 ]. |
523 ^ Iterator on:[:whatToDo | |
518 ^ Iterator on:[:whatToDo | |
524 Smalltalk allClassesDo:[:cls | |
519 Smalltalk allClassesDo:[:cls | |
525 cls isRealNameSpace ifFalse:[ |
520 cls isRealNameSpace ifFalse:[ |
526 whatToDo value:cls |
521 whatToDo value:cls |
527 ] |
522 ] |
528 ] |
523 ] |
529 ] |
524 ] |
530 ]. |
525 ]. |
531 |
526 |
532 selectedPackages size == 1 ifTrue:[ |
527 selectedPackages size == 1 ifTrue:[ |
533 "/ faster common case |
528 "/ faster common case |
534 thePackage := selectedPackages first. |
529 thePackage := selectedPackages first. |
535 |
530 |
536 ^ Iterator on:[:whatToDo | |
531 ^ Iterator on:[:whatToDo | |
537 |changedClasses| |
532 |changedClasses| |
538 |
533 |
539 showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ]. |
534 showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ]. |
540 |
535 |
541 Smalltalk allClassesDo:[:cls | |
536 Smalltalk allClassesDo:[:cls | |
542 |doInclude| |
537 |doInclude| |
543 |
538 |
544 (hideUnloadedClasses not or:[cls isLoaded]) |
539 (hideUnloadedClasses not or:[cls isLoaded]) |
545 ifTrue:[ |
540 ifTrue:[ |
546 cls isRealNameSpace ifFalse:[ |
541 cls isRealNameSpace ifFalse:[ |
547 doInclude := (thePackage = cls package). |
542 doInclude := (thePackage = cls package). |
548 doInclude ifFalse:[ |
543 doInclude ifFalse:[ |
549 cls isJavaClass ifFalse:[ |
544 cls isJavaClass ifFalse:[ |
550 doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package]) |
545 doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package]) |
551 or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]]. |
546 or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]]. |
552 ]. |
547 ]. |
553 doInclude ifFalse:[ |
548 doInclude ifFalse:[ |
554 (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass) |
549 (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass) |
555 or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[ |
550 or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[ |
556 doInclude := true |
551 doInclude := true |
557 ]. |
552 ]. |
558 ]. |
553 ]. |
559 ]. |
554 ]. |
560 doInclude ifTrue:[ |
555 doInclude ifTrue:[ |
561 whatToDo value:cls |
556 whatToDo value:cls |
562 ] |
557 ] |
563 ] |
558 ] |
564 ] |
559 ] |
565 ] |
560 ] |
566 ] |
561 ] |
567 ]. |
562 ]. |
568 |
563 |
569 ^ Iterator on:[:whatToDo | |
564 ^ Iterator on:[:whatToDo | |
570 |changedClasses| |
565 |changedClasses| |
571 |
566 |
572 showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ]. |
567 showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ]. |
573 |
568 |
574 Smalltalk allClassesDo:[:cls | |
569 Smalltalk allClassesDo:[:cls | |
575 |doInclude| |
570 |doInclude| |
576 |
571 |
577 (hideUnloadedClasses not or:[cls isLoaded]) |
572 (hideUnloadedClasses not or:[cls isLoaded]) |
578 ifTrue:[ |
573 ifTrue:[ |
579 cls isRealNameSpace ifFalse:[ |
574 cls isRealNameSpace ifFalse:[ |
580 doInclude := (selectedPackages includes:cls package). |
575 doInclude := (selectedPackages includes:cls package). |
581 doInclude ifFalse:[ |
576 doInclude ifFalse:[ |
582 cls isJavaClass ifFalse:[ |
577 cls isJavaClass ifFalse:[ |
583 doInclude := (cls methodDictionary contains:[:mthd | selectedPackages includes:mthd package]) |
578 doInclude := (cls methodDictionary contains:[:mthd | selectedPackages includes:mthd package]) |
584 or:[ cls class methodDictionary contains:[:mthd | selectedPackages includes:mthd package]]. |
579 or:[ cls class methodDictionary contains:[:mthd | selectedPackages includes:mthd package]]. |
585 doInclude ifFalse:[ |
580 doInclude ifFalse:[ |
586 (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass) |
581 (showChangedClasses and:[ (changedClasses includes:cls theNonMetaclass) |
587 or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[ |
582 or:[(changedClasses includes:cls theMetaclass)] ]) ifTrue:[ |
588 doInclude := true |
583 doInclude := true |
589 ]. |
584 ]. |
590 ]. |
585 ]. |
591 |
586 |
592 ] |
587 ] |
593 ]. |
588 ]. |
594 doInclude ifTrue:[ |
589 doInclude ifTrue:[ |
595 whatToDo value:cls |
590 whatToDo value:cls |
596 ] |
591 ] |
597 ] |
592 ] |
598 ] |
593 ] |
599 ] |
594 ] |
600 ] |
595 ] |
601 |
596 |
602 "Created: / 17-02-2000 / 23:49:37 / cg" |
597 "Created: / 17-02-2000 / 23:49:37 / cg" |
603 "Modified: / 10-11-2006 / 17:15:15 / cg" |
598 "Modified: / 10-11-2006 / 17:15:15 / cg" |
604 ! ! |
599 ! ! |
605 |
600 |
606 !ProjectList methodsFor:'initialize-release'! |
601 !ProjectList methodsFor:'initialize-release'! |
607 |
602 |
608 initialize |
603 initialize |
609 |
604 |
610 super initialize. |
605 super initialize. |
611 workerQueue := SharedQueue new |
606 workerQueue := SharedQueue new. |
|
607 includedPseudoEntryForChanged := true. |
612 |
608 |
613 "Created: / 14-12-2010 / 15:41:23 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
609 "Created: / 14-12-2010 / 15:41:23 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
614 ! |
610 ! |
615 |
611 |
616 release |
612 release |
620 ! ! |
616 ! ! |
621 |
617 |
622 !ProjectList methodsFor:'private'! |
618 !ProjectList methodsFor:'private'! |
623 |
619 |
624 allShownProjects |
620 allShownProjects |
625 |hideUnloaded allProjects generator addWithAllParentPackages hideModules| |
621 |hideUnloaded allProjects projectBag generator addWithAllParentPackages hideModules| |
626 |
622 |
627 hideModules := HideModules ? true. |
623 hideModules := HideModules ? true. |
628 hideModules := HideModules ? false. |
624 hideModules := HideModules ? false. |
629 |
625 |
630 allProjects := IdentitySet new. |
626 allProjects := IdentitySet new. |
|
627 projectBag := Bag new. |
631 |
628 |
632 inGeneratorHolder isNil ifTrue:[ |
629 inGeneratorHolder isNil ifTrue:[ |
633 hideUnloaded := self hideUnloadedClasses value. |
630 hideUnloaded := self hideUnloadedClasses value. |
634 |
631 |
635 addWithAllParentPackages := |
632 addWithAllParentPackages := |
636 [:package | |
633 [:package | |
637 |p parent module| |
634 |p parent module| |
638 |
635 |
639 (allProjects includes:package) ifFalse:[ |
636 (allProjects includes:package) ifFalse:[ |
640 allProjects add:package. |
637 allProjects add:package. |
641 (package ~= PackageId noProjectID |
638 (package ~= PackageId noProjectID |
642 and:[package ~= #private]) ifTrue:[ |
639 and:[package ~= #private]) ifTrue:[ |
643 p := package asPackageId. |
640 p := package asPackageId. |
644 [(parent := p parentPackage) notNil] whileTrue:[ |
641 [(parent := p parentPackage) notNil] whileTrue:[ |
645 allProjects add:parent asSymbol. |
642 allProjects add:parent asSymbol. |
646 p := parent. |
643 p := parent. |
647 ]. |
644 ]. |
648 hideModules ifFalse:[ |
645 hideModules ifFalse:[ |
649 (module := p module) notNil ifTrue:[ |
646 (module := p module) notNil ifTrue:[ |
650 allProjects add:module asSymbol. |
647 allProjects add:module asSymbol. |
651 ]. |
648 ]. |
652 ]. |
649 ]. |
653 ]. |
650 ]. |
654 ]. |
651 ]. |
655 ]. |
652 ]. |
656 |
653 |
657 Smalltalk allClassesDo:[:eachClass | |
654 Smalltalk allClassesDo:[:eachClass | |
658 |cls pkg p classPackage| |
655 |cls pkg p classPackage| |
659 |
656 |
660 eachClass isRealNameSpace ifFalse:[ |
657 eachClass isRealNameSpace ifFalse:[ |
661 |
658 |
662 (hideUnloaded not or:[eachClass isLoaded]) ifTrue:[ |
659 (hideUnloaded not or:[eachClass isLoaded]) ifTrue:[ |
663 cls := eachClass theNonMetaclass. |
660 cls := eachClass theNonMetaclass. |
664 cls isPrivate ifTrue:[ |
661 cls isPrivate ifTrue:[ |
665 cls := cls topOwningClass |
662 cls := cls topOwningClass |
666 ]. |
663 ]. |
667 |
664 |
668 classPackage := cls package ? (PackageId noProjectID). |
665 classPackage := cls package ? (PackageId noProjectID). |
669 classPackage size > 0 ifTrue:[ |
666 classPackage size > 0 ifTrue:[ |
670 addWithAllParentPackages value:classPackage asSymbol. |
667 classPackage := classPackage asSymbol. |
671 ] ifFalse:[ |
668 addWithAllParentPackages value:classPackage. |
672 "/ for now, nameSpaces are not in any package; |
669 projectBag add:classPackage. |
673 "/ this might change. Then, 0-sized packages are |
670 ] ifFalse:[ |
674 "/ illegal, and the following should be enabled. |
671 "/ for now, nameSpaces are not in any package; |
675 "/ self halt |
672 "/ this might change. Then, 0-sized packages are |
676 ]. |
673 "/ illegal, and the following should be enabled. |
677 cls isJavaClass ifFalse:[ |
674 "/ self halt |
678 cls instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
675 ]. |
679 |mpkg| |
676 |
680 |
677 cls isJavaClass ifFalse:[ |
681 mpkg := mthd package asSymbol. |
678 cls instAndClassSelectorsAndMethodsDo:[:sel :mthd | |
682 mpkg ~~ classPackage ifTrue:[ |
679 |mpkg| |
683 (allProjects includes:mpkg) ifFalse:[ |
680 |
684 addWithAllParentPackages value:mpkg. |
681 mpkg := mthd package asSymbol. |
685 ] |
682 mpkg ~~ classPackage ifTrue:[ |
686 ]. |
683 (allProjects includes:mpkg) ifFalse:[ |
687 ]. |
684 addWithAllParentPackages value:mpkg. |
688 ]. |
685 ] |
689 ]. |
686 ]. |
690 ]. |
687 ]. |
691 ]. |
688 ]. |
692 allProjects := allProjects asOrderedCollection. |
689 ]. |
693 |
690 ]. |
694 "/ those are simulated - in ST/X, empty projects do not |
691 ]. |
695 "/ really exist; however, during browsing, it makes sense. |
692 allProjects := allProjects asOrderedCollection. |
696 AdditionalEmptyProjects size > 0 ifTrue:[ |
693 |
697 "/ remove those that are present ... |
694 "/ those are simulated - in ST/X, empty projects do not |
698 AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not]. |
695 "/ really exist; however, during browsing, it makes sense. |
699 allProjects addAll:AdditionalEmptyProjects. |
696 AdditionalEmptyProjects size > 0 ifTrue:[ |
700 ]. |
697 "/ remove those that are present ... |
|
698 AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not]. |
|
699 allProjects addAll:AdditionalEmptyProjects. |
|
700 ]. |
701 ] ifFalse:[ |
701 ] ifFalse:[ |
702 generator := inGeneratorHolder value. |
702 generator := inGeneratorHolder value. |
703 generator isNil ifTrue:[^ #() ]. |
703 generator isNil ifTrue:[^ #() ]. |
704 generator do:[:prj | allProjects add:prj]. |
704 generator do:[:prj | allProjects add:prj]. |
705 ]. |
705 ]. |
706 ^ allProjects asOrderedCollection. |
706 ^ allProjects asOrderedCollection. |
707 |
707 |
708 "Modified: / 16-01-2007 / 15:56:16 / cg" |
708 "Modified: / 16-01-2007 / 15:56:16 / cg" |
709 ! |
709 ! |
723 |
723 |
724 listOfProjects |
724 listOfProjects |
725 |allProjects numClassesInChangeSet| |
725 |allProjects numClassesInChangeSet| |
726 |
726 |
727 allProjects := self allShownProjects copyAsOrderedCollection. |
727 allProjects := self allShownProjects copyAsOrderedCollection. |
728 |
|
729 allProjects sort. |
728 allProjects sort. |
|
729 |
730 allProjects size == 1 ifTrue:[ |
730 allProjects size == 1 ifTrue:[ |
731 "/ self projectLabelHolder value:(allProjects first , ' [Project]'). |
731 "/ self projectLabelHolder value:(allProjects first , ' [Project]'). |
732 self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first). |
732 self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first). |
733 ]. |
733 ]. |
734 |
734 |
735 numClassesInChangeSet := ChangeSet current changedClasses size. |
735 includedPseudoEntryForChanged ifTrue:[ |
736 numClassesInChangeSet > 0 ifTrue:[ |
736 numClassesInChangeSet := ChangeSet current changedClasses size. |
737 "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists) |
737 numClassesInChangeSet > 0 ifTrue:[ |
738 allProjects addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic). |
738 "/ don't include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists) |
|
739 allProjects addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic). |
|
740 ]. |
739 ]. |
741 ]. |
740 |
742 |
741 allProjects size > 1 ifTrue:[ |
743 allProjects size > 1 ifTrue:[ |
742 allProjects addFirst:(self class nameListEntryForALL allItalic). |
744 allProjects addFirst:(self class nameListEntryForALL allItalic). |
743 ]. |
745 ]. |
744 |
746 |
745 ^ allProjects |
747 ^ allProjects |
746 |
748 |
747 "Created: / 17-02-2000 / 23:43:05 / cg" |
749 "Created: / 17-02-2000 / 23:43:05 / cg" |
814 |
816 |
815 packagesInChangeSet := ChangeSet current changedPackages. |
817 packagesInChangeSet := ChangeSet current changedPackages. |
816 |
818 |
817 projectNameList := OrderedCollection new. |
819 projectNameList := OrderedCollection new. |
818 aProjectList do:[:this | |
820 aProjectList do:[:this | |
819 |thisC entry rawEntry prefix indent| |
821 |thisC entry rawEntry prefix indent| |
820 |
822 |
821 this = self class nameListEntryForALL ifTrue:[ |
823 this = self class nameListEntryForALL ifTrue:[ |
822 entry := this |
824 entry := this |
823 ] ifFalse:[ |
825 ] ifFalse:[ |
824 thisC := this asCollectionOfSubstringsSeparatedByAny:':/'. |
826 thisC := this asCollectionOfSubstringsSeparatedByAny:':/'. |
825 thisC isEmpty ifTrue:[ |
827 thisC isEmpty ifTrue:[ |
826 thisC := Array with:(PackageId noProjectID). |
828 thisC := Array with:(PackageId noProjectID). |
827 ]. |
829 ]. |
828 |
830 |
829 [ |
831 [ |
830 |stackTop| |
832 |stackTop| |
831 |
833 |
832 stack notEmpty |
834 stack notEmpty |
833 and:[ |
835 and:[ |
834 stackTop := stack last. |
836 stackTop := stack last. |
835 (thisC startsWith:stackTop) ifFalse:[ |
837 (thisC startsWith:stackTop) ifFalse:[ |
836 stack removeLast. |
838 stack removeLast. |
837 true |
839 true |
838 ] ifTrue:[ |
840 ] ifTrue:[ |
839 false |
841 false |
840 ]] |
842 ]] |
841 ] whileTrue. |
843 ] whileTrue. |
842 prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ]. |
844 prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ]. |
843 indent := stack size * 4. |
845 indent := stack size * 4. |
844 stack addLast:thisC. |
846 stack addLast:thisC. |
845 prefix isEmpty ifTrue:[ |
847 prefix isEmpty ifTrue:[ |
846 rawEntry := thisC first. |
848 rawEntry := thisC first. |
847 thisC size > 1 ifTrue:[ |
849 thisC size > 1 ifTrue:[ |
848 rawEntry := rawEntry , ':' , ((thisC copyFrom:2) asStringWith:$/). |
850 rawEntry := rawEntry , ':' , ((thisC copyFrom:2) asStringWith:$/). |
849 ] |
851 ] |
850 ] ifFalse:[ |
852 ] ifFalse:[ |
851 rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/. |
853 rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/. |
852 ]. |
854 ]. |
853 |
855 |
854 |
856 (packagesInChangeSet includes:this) ifTrue:[ |
855 (packagesInChangeSet includes:this) ifTrue:[ |
857 rawEntry := rawEntry , self class markForBeingInChangeList. |
856 rawEntry := rawEntry , self class markForBeingInChangeList. |
858 rawEntry := self colorizeForChangedCode:rawEntry. |
857 rawEntry := self colorizeForChangedCode:rawEntry. |
859 ]. |
858 ]. |
860 |
859 entry := (String new:indent) , rawEntry. |
861 entry := (String new:indent) , rawEntry. |
860 ((ConfigurableFeatures includesFeature: #SubversionSupportEnabled) and:[this first ~= $*]) ifTrue:[ |
862 ((ConfigurableFeatures includesFeature: #SubversionSupportEnabled) and:[this first ~= $*]) ifTrue:[ |
861 entry := self markEntry: entry at: projectNameList size + 1 |
863 entry := self markEntry: entry at: projectNameList size + 1 forBeingManagedBySVN: this. |
862 forBeingManagedBySVN: this. |
864 ]. |
863 ]. |
865 ]. |
864 ]. |
866 projectNameList add:entry. |
865 projectNameList add:entry. |
867 ]. |
866 ]. |
868 self startWorker. |
867 self startWorker. |
|
868 ^ projectNameList. |
869 ^ projectNameList. |
869 |
870 |
870 "Created: / 17-02-2000 / 23:43:05 / cg" |
871 "Created: / 17-02-2000 / 23:43:05 / cg" |
871 "Modified: / 07-09-2011 / 10:45:05 / cg" |
872 "Modified: / 07-09-2011 / 10:45:05 / cg" |
872 "Modified: / 19-01-2012 / 10:46:53 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
873 "Modified: / 19-01-2012 / 10:46:53 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
873 ! |
874 ! |
874 |
875 |
875 startWorker |
876 startWorker |
876 |
877 |
877 worker ifNil: |
878 worker ifNil: |
878 [worker := |
879 [worker := |
879 [[workerQueue notEmpty ] whileTrue: |
880 [[workerQueue notEmpty ] whileTrue: |
880 [| job | |
881 [| job | |
881 job := workerQueue next. |
882 job := workerQueue next. |
882 job value]. |
883 job value]. |
883 worker := nil. |
884 worker := nil. |
884 ] newProcess. |
885 ] newProcess. |
885 worker resume]. |
886 worker resume]. |
886 |
887 |
887 "Created: / 14-12-2010 / 15:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
888 "Created: / 14-12-2010 / 15:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
888 "Modified: / 16-12-2010 / 17:35:37 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
889 "Modified: / 16-12-2010 / 17:35:37 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
889 ! |
890 ! |
890 |
891 |
903 "/ selectedProjectsHolder removeDependent:self. |
904 "/ selectedProjectsHolder removeDependent:self. |
904 "/ selectedProjectsHolder value:#(). |
905 "/ selectedProjectsHolder value:#(). |
905 "/ selectedProjectsHolder addDependent:self. |
906 "/ selectedProjectsHolder addDependent:self. |
906 "/ ]. |
907 "/ ]. |
907 |
908 |
908 self projectList value:newList. |
909 self projectList value:newList. |
909 listValid := true. |
910 listValid := true. |
910 self projectNameList value:newNameList. |
911 self projectNameList value:newNameList. |
911 |
912 |
912 oldSelection size > 0 ifTrue:[ |
913 oldSelection size > 0 ifTrue:[ |
913 newSelection := oldSelection select:[:prj | newList includes:prj]. |
914 newSelection := oldSelection select:[:prj | newList includes:prj]. |
914 selectedProjectsHolder value:newSelection. |
915 selectedProjectsHolder value:newSelection. |
915 ] |
916 ] |
916 ]. |
917 ]. |
917 listValid := true. |
918 listValid := true. |
918 |
919 |
919 "Modified: / 25.2.2000 / 23:10:01 / cg" |
920 "Modified: / 25.2.2000 / 23:10:01 / cg" |
920 ! ! |
|
921 |
|
922 !ProjectList methodsFor:'setup'! |
|
923 |
|
924 commonPostBuild |
|
925 |
|
926 "JV@2012-03-08: HACK HACK HACK - fixes bug D1863581" |
|
927 self slaveMode value == true ifTrue:[ |
|
928 self updateList |
|
929 ]. |
|
930 |
|
931 super commonPostBuild. |
|
932 |
|
933 "Created: / 08-03-2012 / 17:35:56 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
934 ! ! |
921 ! ! |
935 |
922 |
936 !ProjectList methodsFor:'special'! |
923 !ProjectList methodsFor:'special'! |
937 |
924 |
938 addAdditionalProject:aProject |
925 addAdditionalProject:aProject |
939 "/ those are simulated - in ST/X, empty projects do not |
926 "/ those are simulated - in ST/X, empty projects do not |
940 "/ really exist; however, during browsing, it makes sense. |
927 "/ really exist; however, during browsing, it makes sense. |
941 AdditionalEmptyProjects isNil ifTrue:[ |
928 AdditionalEmptyProjects isNil ifTrue:[ |
942 AdditionalEmptyProjects := Set new. |
929 AdditionalEmptyProjects := Set new. |
943 ]. |
930 ]. |
944 AdditionalEmptyProjects add:aProject. |
931 AdditionalEmptyProjects add:aProject. |
945 |
932 |
946 Smalltalk changed:#projectOrganization "/ not really ... to force update |
933 Smalltalk changed:#projectOrganization "/ not really ... to force update |
947 |
934 |