ApplicationModel subclass:#ClassRevisionTree
instanceVariableNames:'selectionHolder classHolder menuBlock selectionBlock
classItemClass listView semaphoreCritical revisionInfoList
revisionTask currentClassItemInTask'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers'
!
!ClassRevisionTree class methodsFor:'interface spec'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ClassRevisionTree andSelector:#windowSpec
ClassRevisionTree new openInterface:#windowSpec
ClassRevisionTree open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassVersionTree'
#name: 'ClassVersionTree'
#min: #(#Point 10 10)
#max: #(#Point 9999 9999)
#bounds: #(#Rectangle 16 46 881 575)
)
#component:
#(#SpecCollection
#collection: #(
#(#HierarchicalListViewSpec
#name: 'HierarchicalItemListView'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#menu: #selectItemMenu
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#listModel: #listModel
#multipleSelectOk: true
#useIndex: false
#highlightMode: #label
#doubleClickSelector: #doubleClick:
#selectConditionSelector: #isItemSelectable:
#indicatorSelector: #doubleClick:
#retrieveIconsSelector: #icons
)
)
)
)
! !
!ClassRevisionTree class methodsFor:'protocol'!
classItemClass
^ClassItem
!
classItemRootClass
^ClassItemRoot
! !
!ClassRevisionTree class methodsFor:'startup'!
openOnClassHolder:aClassHolder
|theTree|
theTree := self new.
theTree allButOpen.
theTree classHolder:aClassHolder.
theTree openWindow.
^theTree
"
|theSelectionHolder theClassHolder theTree|
theSelectionHolder := ValueHolder new.
theClassHolder := ValueHolder new.
theSelectionHolder compute:[:coll |
coll do:[:each | Transcript showCR: each]].
theClassHolder value:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
theTree := ClassRevisionTree openOnClassHolder:theClassHolder.
theSelectionHolder value:(Array with:(theTree itemList children last)).
theTree selectionHolder:theSelectionHolder.
Delay waitForMilliseconds:1500.
theClassHolder value:(Project current changedClasses).
Delay waitForMilliseconds:1500.
theTree classHolder:nil.
Delay waitForMilliseconds:1500.
theTree classHolder:theClassHolder.
Delay waitForMilliseconds:1500.
theClassHolder value:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
"
!
openOnClasses:aClassColl
|theTree|
theTree := self new.
theTree allButOpen.
theTree classHolder value:aClassColl.
theTree openWindow.
^theTree
"
|theSelectionHolder theTree|
theSelectionHolder := ValueHolder new.
theSelectionHolder compute:[:coll |
coll do:[:each | Transcript showCR: each]].
theTree := ClassRevisionTree openOnClasses:(Smalltalk allClasses asOrderedCollection sort:[:x : y|x name < y name]).
theSelectionHolder value:(Array with:(theTree itemList children last)).
theTree selectionHolder:theSelectionHolder.
"
! !
!ClassRevisionTree methodsFor:'accessing'!
classItemClass
"return the value of the instance variable 'classItemClass' (automatically generated)"
^ classItemClass ifNil:[classItemClass := self class classItemClass]
!
classItemClass:something
"set the value of the instance variable 'classItemClass' (automatically generated)"
classItemClass := something.!
classItemRootClass
"return the value of the instance variable 'classItemClass' (automatically generated)"
^ self class classItemRootClass
!
itemForSelectionIndex:anIndex
""
^self listModel at:anIndex ifAbsent:nil
!
itemList
"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."
^ self listModel root
!
revisionInfoList
"return the value of the instance variable 'revisionInfoList' (automatically generated)"
^ revisionInfoList ifNil:[revisionInfoList := IdentitySet new]
!
semaphoreCritical
"return the value of the instance variable 'semaphoreCritical' (automatically generated)"
^ semaphoreCritical ifNil:[semaphoreCritical := RecursionLock new]
! !
!ClassRevisionTree methodsFor:'actions'!
doubleClick:anIndex
|theItem|
(((theItem := self itemForSelectionIndex:anIndex) isExpandableRevisionItem) and:[listView sensor shiftDown])
ifTrue: [theItem recursiveToggleExpand]
ifFalse:[theItem toggleExpand]
!
getRevisionInfoForClassItem: aClassItem
self semaphoreCritical critical:[
|theList|
currentClassItemInTask == aClassItem ifTrue:[^self].
(theList := self revisionInfoList) removeIdentical:aClassItem ifAbsent:[nil].
theList add:aClassItem.
self startRevisionTask]
!
isItemSelectable:anIndex
"
checks if an item at anIndex can be selected. If an selection block
is set, evaluate it with the selected item.
(Callback from the tree).
<return: Boolean>
"
selectionBlock ifNil:[^true].
^selectionBlock value:(self itemForSelectionIndex:anIndex)
! !
!ClassRevisionTree methodsFor:'aspects'!
icons
|icons|
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
!
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."
|holder|
(holder := builder bindingAt:#listModel) isNil ifTrue:[
holder := HierarchicalList new.
holder root:(self classItemRootClass new).
holder showRoot:false.
builder aspectAt:#listModel put:holder.
holder application:self.
].
^ holder.
! !
!ClassRevisionTree methodsFor:'change & update'!
update:something with:aParameter from:changedObject
changedObject == self classHolder
ifTrue:[self setUpItemList].
! !
!ClassRevisionTree methodsFor:'interface opening'!
postBuildWith: aBuilder
super postBuildWith: aBuilder.
listView := self builder componentAt:#HierarchicalItemListView.
selectionHolder notNil
ifTrue:[listView model:selectionHolder].
listView useDefaultIcons:false.
!
release
self stopRevisionTask.
^super release
! !
!ClassRevisionTree methodsFor:'menu actions'!
selectItemMenu
"
get the menu for the selected items.If a menuBlock is set then evalute this block
with the current selection.
<return: Menu|nil>
"
^ [ menuBlock value ]
! !
!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|
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.
]
]
].
! !
!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)"
^ menuBlock
!
menuBlock:something
"set the value of the instance variable 'menuBlock' (automatically generated)"
menuBlock := something.!
selectionBlock
"return the value of the instance variable 'selectionBlock' (automatically generated)"
^ selectionBlock!
selectionBlock:something
"set the value of the instance variable 'selectionBlock' (automatically generated)"
selectionBlock := something.!
selectionHolder
^selectionHolder
!
selectionHolder:aValueHolder
"set the value of the instance variable 'revisionItemSelection' (automatically generated)"
selectionHolder := aValueHolder.
listView ifNil:[^self].
listView model:selectionHolder
! !
!ClassRevisionTree methodsFor:'protocol setup'!
setupOnClasses:aClassColl
self classHolder value:aClassColl.
"
|theTree|
theTree := ClassRevisionTree new.
theTree open.
theTree setupOnClasses:#(VersionDiffBrowser HierarchicalVersionDiffBrowser SourceRevisionItem Project)
"
! !
!ClassRevisionTree class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/ClassRevisionTree.st,v 1.5 2000-01-14 15:13:51 ps Exp $'
! !