--- a/ClassRevisionTree.st Tue Feb 15 17:47:37 2000 +0100
+++ b/ClassRevisionTree.st Tue Feb 15 17:49:27 2000 +0100
@@ -1,7 +1,6 @@
ApplicationModel subclass:#ClassRevisionTree
- instanceVariableNames:'selectionHolder classHolder menuBlock selectionBlock
- classItemClass listView semaphoreCritical revisionInfoList
- revisionTask currentClassItemInTask'
+ instanceVariableNames:'selectionHolder dataHolder menuBlock selectionBlock listView
+ hierarchicalList'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-Support'
@@ -79,11 +78,6 @@
!ClassRevisionTree class methodsFor:'protocol'!
-classItemClass
-
- ^ClassItem
-!
-
classItemRootClass
^ClassItemRoot
@@ -97,6 +91,7 @@
theTree := self new.
theTree allButOpen.
+ theTree classItemRootClass:ClassItemRoot.
theTree classHolder:aClassHolder.
theTree openWindow.
^theTree
@@ -113,7 +108,7 @@
theSelectionHolder value:(Array with:(theTree itemList children last)).
theTree selectionHolder:theSelectionHolder.
Delay waitForMilliseconds:1500.
-theClassHolder value:(Project current changedClasses).
+theClassHolder value:(Project current changedClasses asOrderedCollection).
Delay waitForMilliseconds:1500.
theTree classHolder:nil.
Delay waitForMilliseconds:1500.
@@ -126,15 +121,58 @@
!
+openOnClassRevisionInfoColl:aClassRevisionInfoColl
+
+ |theTree|
+
+ theTree := self new.
+ theTree allButOpen.
+ theTree classItemRootClass:ClassItemRootForRevision.
+ theTree dataHolder value:aClassRevisionInfoColl.
+ theTree openWindow.
+ ^theTree
+"
+|theTree infoLog|
+
+infoLog := OrderedCollection new.
+CVSSourceCodeManager reportHistoryLogSince:'yesterday'
+ filterSTSources:true
+ filterUser:nil
+ filterRepository:nil
+ inTo:[:info| infoLog add:info].
+
+theTree := self new.
+theTree open.
+theTree classItemRootClass:ClassItemRootForRevision.
+theTree setupOnClasses:infoLog
+"
+
+"
+|infoLog|
+
+infoLog := OrderedCollection new.
+CVSSourceCodeManager reportHistoryLogSince:'yesterday'
+ filterSTSources:true
+ filterUser:nil
+ filterRepository:nil
+ inTo:[:info| infoLog add:info].
+self openOnClassRevisionInfoColl:infoLog.
+"
+!
+
openOnClasses:aClassColl
|theTree|
theTree := self new.
+ theTree classItemRootClass:ClassItemRoot.
theTree allButOpen.
- theTree classHolder value:aClassColl.
+ theTree setupOnClasses:aClassColl.
theTree openWindow.
- ^theTree
+ ^theTree
+"
+self openOnClasses:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
+"
"
|theSelectionHolder theTree|
@@ -150,25 +188,59 @@
!ClassRevisionTree methodsFor:'accessing'!
-classItemClass
- "return the value of the instance variable 'classItemClass' (automatically generated)"
+dataHolder
+ "return the value of the instance variable 'classHolder' (automatically generated)"
+
+ ^dataHolder ifNil:[
+ dataHolder := ValueHolder new.
+ dataHolder addDependent:self
+ ]
+!
- ^ classItemClass ifNil:[classItemClass := self class classItemClass]
+dataHolder:aValueHolder
+ "set the value of the instance variable 'classHolder' (automatically generated)"
+
+ (dataHolder ~~ aValueHolder) ifTrue:[
+ dataHolder removeDependent:self.
+ dataHolder := aValueHolder.
+ dataHolder notNil ifTrue:[
+ dataHolder addDependent:self.
+ ].
+ self setUpList
+ ].
!
-classItemClass:something
- "set the value of the instance variable 'classItemClass' (automatically generated)"
+hierarchicalList
+"
+returns a hierarchical list which is the model for tree. All necassary things like icons,
+root and subnodes must be hold by this list. Therefore the list must have a special protocoll.
+See examples.
- classItemClass := something.!
+<return: HierarchicalList>
+"
-classItemRootClass
- "return the value of the instance variable 'classItemClass' (automatically generated)"
+ hierarchicalList isNil
+ ifTrue:[self error: 'no necessary list is set'. "hierarchicalList := HierarchicalList new"].
+ ^ hierarchicalList
+!
- ^ self class classItemRootClass
+hierarchicalList:aHierarchicalList
+"
+sets the hierarchical list which is the model for tree. All necassary things like icons
+root and subnodes must be hold by this list. Therefore the list must have a special protocoll.
+See examples.
+
+<return: self>
+"
+
+ hierarchicalList := aHierarchicalList.
!
itemForSelectionIndex:anIndex
-""
+"
+
+<return: HierarchicalItem | nil >
+"
^self listModel at:anIndex ifAbsent:nil
!
@@ -187,17 +259,15 @@
!
-revisionInfoList
- "return the value of the instance variable 'revisionInfoList' (automatically generated)"
+listView
+ "return the value of the instance variable 'listView' (automatically generated)"
- ^ revisionInfoList ifNil:[revisionInfoList := IdentitySet new]
-!
+ ^ listView!
-semaphoreCritical
- "return the value of the instance variable 'semaphoreCritical' (automatically generated)"
+listView:something
+ "set the value of the instance variable 'listView' (automatically generated)"
- ^ semaphoreCritical ifNil:[semaphoreCritical := RecursionLock new]
-! !
+ listView := something.! !
!ClassRevisionTree methodsFor:'actions'!
@@ -205,19 +275,9 @@
|theItem|
- (((theItem := self itemForSelectionIndex:anIndex) isExpandableRevisionItem) and:[listView sensor shiftDown])
- ifTrue: [theItem recursiveToggleExpand]
- ifFalse:[theItem toggleExpand]
-!
-
-getRevisionInfoForClassItem: aClassItem
+ theItem := self itemForSelectionIndex:anIndex. self halt.
+ self listModel root doubleClickOn:theItem.
- self semaphoreCritical critical:[
- |theList|
- currentClassItemInTask == aClassItem ifTrue:[^self].
- (theList := self revisionInfoList) removeIdentical:aClassItem ifAbsent:[nil].
- theList add:aClassItem.
- self startRevisionTask]
!
isItemSelectable:anIndex
@@ -236,30 +296,23 @@
!ClassRevisionTree methodsFor:'aspects'!
icons
- |icons|
+"
+gets the icons from hierarchical list which should be registered on the view.
- icons := Dictionary new.
- icons at:#loadedRevision put:(Image fromFile:'gifImages/artwork/dots/red_ball.gif').
- icons at:#unloadedRevision put:(Image fromFile:'gifImages/artwork/dots/green_ball.gif').
- icons at:#unloadedClassItem put:(Image fromFile:'xpmBitmaps/file_images/small_folder_yellow_grey1.xpm').
- icons at:#loadingClassItem put:(Image fromFile:'xpmBitmaps/file_images/small_folder_yellow_search.xpm').
- icons at:#loadedClassItem put:(Image fromFile:'xpmBitmaps/file_images/small_folder_yellow.xpm').
- ^icons
+<return: Dictionary of: Symbol->Image | nil>
+"
+ ^self hierarchicalList icons
!
listModel
- "automatically generated by UIPainter ..."
+"
- "*** the code below creates a default model when invoked."
- "*** (which may not be the one you wanted)"
- "*** Please change as required and accept it in the browser."
-
+<return: HierarchicalList>
+"
|holder|
(holder := builder bindingAt:#listModel) isNil ifTrue:[
- holder := HierarchicalList new.
- holder root:(self classItemRootClass new).
- holder showRoot:false.
+ holder := self hierarchicalList.
builder aspectAt:#listModel put:holder.
holder application:self.
].
@@ -270,8 +323,8 @@
update:something with:aParameter from:changedObject
- changedObject == self classHolder
- ifTrue:[self setUpItemList].
+ changedObject == self dataHolder
+ ifTrue:[self setUpList].
! !
@@ -281,15 +334,15 @@
postBuildWith: aBuilder
super postBuildWith: aBuilder.
- listView := self builder componentAt:#HierarchicalItemListView.
+ self listView:(self builder componentAt:#HierarchicalItemListView).
selectionHolder notNil
ifTrue:[listView model:selectionHolder].
- listView useDefaultIcons:false.
+ self listView useDefaultIcons:false.
!
release
- self stopRevisionTask.
+"/ self stopItemTask.
^super release
@@ -309,95 +362,14 @@
!ClassRevisionTree methodsFor:'private'!
-revisionTaskCycle
-
- |theClassItem|
-
- [
- theClassItem := nil.
- self semaphoreCritical critical:[
- self revisionInfoList notEmpty
- ifTrue:[theClassItem := self revisionInfoList remove:(self revisionInfoList last) ifAbsent:[nil]]
- ].
- (theClassItem notNil and:[theClassItem needsChildren])ifTrue:[
- currentClassItemInTask:=theClassItem.
- theClassItem computeRevisions.
- currentClassItemInTask:=nil
- ].
- theClassItem notNil
- ] whileTrue.
-!
-
-setUpItemList
-
- |theClassColl theClassItemColl root|
+setUpList
- root := self classItemRootClass new.
- (theClassColl := self classHolder value) notNil ifTrue:[
- theClassItemColl := theClassColl collect:[:eachClass |
- |theClassItem theClass|
- theClassItem := self classItemClass new.
- theClass := Smalltalk resolveName:eachClass inClass:Smalltalk.
- theClassItem myClass:theClass.
- theClassItem].
- root addAll: theClassItemColl.
- ].
- self listModel root:root.
-!
-
-startRevisionTask
-
- self semaphoreCritical critical:[
- revisionTask ifNil:[
- revisionTask := Process for:[
- self revisionTaskCycle
- ]
- priority:(Processor userBackgroundPriority).
- revisionTask addExitAction:[revisionTask := nil].
- revisionTask resume.
- ].
- ].
-!
-
-stopRevisionTask
- |task|
-
- self semaphoreCritical critical:[
- (task := revisionTask) notNil ifTrue:[
- revisionTask := nil.
- Exception handle:[:ex|] do:[
- task terminateWithAllSubprocesses.
- task waitUntilTerminated.
- ]
- ]
- ].
-
+ self halt.
+ ^self hierarchicalList newData: self dataHolder value
! !
!ClassRevisionTree methodsFor:'protocol accessing'!
-classHolder
- "return the value of the instance variable 'classHolder' (automatically generated)"
-
- ^classHolder ifNil:[
- classHolder := ValueHolder new.
- classHolder addDependent:self
- ]
-!
-
-classHolder:aValueHolder
- "set the value of the instance variable 'classHolder' (automatically generated)"
-
- (classHolder ~~ aValueHolder) ifTrue:[
- classHolder removeDependent:self.
- classHolder := aValueHolder.
- classHolder notNil ifTrue:[
- classHolder addDependent:self.
- ].
- self setUpItemList
- ].
-!
-
menuBlock
"return the value of the instance variable 'menuBlock' (automatically generated)"
@@ -428,26 +400,44 @@
"set the value of the instance variable 'revisionItemSelection' (automatically generated)"
selectionHolder := aValueHolder.
- listView ifNil:[^self].
- listView model:selectionHolder
+ self listView ifNil:[^self].
+ self listView model:selectionHolder
! !
!ClassRevisionTree methodsFor:'protocol setup'!
-setupOnClasses:aClassColl
+setupOnData:aDataObject
- self classHolder value:aClassColl.
+ self dataHolder value:aDataObject.
"
-|theTree|
+|theTree infoLog theHierarchicalList|
theTree := ClassRevisionTree new.
+theHierarchicalList := HierarchicalClassRevisionList new.
+theTree hierarchicalList:theHierarchicalList.
theTree open.
-theTree setupOnClasses:#(VersionDiffBrowser HierarchicalVersionDiffBrowser SourceRevisionItem Project)
+infoLog := OrderedCollection new.
+theTree setupOnData:infoLog.
+"
+"
+|theTree infoLog theHierarchicalList|
+
+theTree := ClassRevisionTree new.
+theHierarchicalList := HierarchicalClassRevisionList new.
+theTree hierarchicalList:theHierarchicalList.
+infoLog := OrderedCollection new.
+CVSSourceCodeManager reportHistoryLogSince:'yesterday'
+ filterSTSources:true
+ filterUser:nil
+ filterRepository:nil
+ inTo:[:info| infoLog add:info].
+theTree open.
+theTree setupOnData:infoLog.
"
! !
!ClassRevisionTree class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/ClassRevisionTree.st,v 1.6 2000-01-14 15:57:06 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/ClassRevisionTree.st,v 1.7 2000-02-15 16:49:16 ps Exp $'
! !