ApplicationModel subclass:#ClassRevisionTree
	instanceVariableNames:'selectionHolder classHolder menuBlock selectionBlock
		classItemClass listView semaphoreCritical revisionInfoList
		revisionTask currentClassItemInTask'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Browsers-Support'
!

!ClassRevisionTree class methodsFor:'documentation'!

documentation
"
    documentation to be added.

    [author:]
        Pierre Schwarz (ps@exept.de)

    [see also:]

    [instance variables:]

    [class variables:]
"

! !

!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.6 2000-01-14 15:57:06 cg Exp $'
! !