ApplicationModel subclass:#ClassRevisionTree

	instanceVariableNames:'selectionHolder classHolder menuBlock selectionBlock

		classItemClass listView semaphoreCritical revisionInfoList

		revisionTask currentClassItemInTask'

	classVariableNames:''

	poolDictionaries:''

!

!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

! !