"

 COPYRIGHT (c) 2000 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

BrowserList subclass:#ProjectList

	instanceVariableNames:'projectList projectNameList selectionIndexHolder worker

		workerQueue includedPseudoEntryForChanged selectionIndexValid'

	classVariableNames:'AdditionalEmptyProjects HideModules'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

!ProjectList class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2000 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    I implement the project list in the new system browser

"

! !

!ProjectList class methodsFor:'interface specs'!

singleProjectWindowSpec

    "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:ClassCategoryList andSelector:#singleCategoryWindowSpec

     ClassCategoryList new openInterface:#singleCategoryWindowSpec

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

	#name: #singleProjectWindowSpec

	#window: 

       #(#WindowSpec

	  #label: 'ProjectList'

	  #name: 'ProjectList'

	  #min: #(#Point 0 0)

	  #max: #(#Point 1024 721)

	  #bounds: #(#Rectangle 218 175 518 475)

	)

	#component: 

       #(#SpecCollection

	  #collection: #(

	   #(#LabelSpec

	      #label: 'ProjectName'

	      #name: 'ProjectLabel'

	      #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)

	      #translateLabel: true

	      #labelChannel: #projectLabelHolder

	      #menu: #menuHolder

	    )

	   )

	)

      )

!

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:ProjectList andSelector:#windowSpec

     ProjectList new openInterface:#windowSpec

     ProjectList open

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

        #name: #windowSpec

        #window: 

       #(#WindowSpec

          #label: 'ProjectList'

          #name: 'ProjectList'

          #min: #(#Point 0 0)

          #bounds: #(#Rectangle 13 23 313 323)

        )

        #component: 

       #(#SpecCollection

          #collection: #(

           #(#SequenceViewSpec

              #name: 'List'

              #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)

              #tabable: true

              #model: #selectionIndexHolder

              #menu: #menuHolder

              #hasHorizontalScrollBar: true

              #hasVerticalScrollBar: true

              #miniScrollerHorizontal: true

              #isMultiSelect: true

              #valueChangeSelector: #selectionChangedByClick

              #useIndex: true

              #sequenceList: #projectNameList

              #doubleClickChannel: #doubleClickChannel

              #properties: 

             #(#PropertyListDictionary

                #dragArgument: nil

                #dropArgument: nil

                #canDropSelector: #canDropContext:

                #dropSelector: #doDropContext:

              )

            )

           )

        )

      )

    "Created: / 17.2.2000 / 23:45:47 / cg"

    "Modified: / 17.2.2000 / 23:47:53 / cg"

! !

!ProjectList class methodsFor:'queries-plugin'!

aspectSelectors

    ^ #( 

        environmentHolder

        #(#doubleClickChannel #action )

        immediateUpdate 

        selectedProjects 

        menuHolder 

        outGeneratorHolder 

        inGeneratorHolder 

        selectionChangeCondition

        updateTrigger

        forceGeneratorTrigger

        hideUnloadedClasses

        organizerMode

        slaveMode

       )

    "Created: / 17-02-2000 / 23:46:18 / cg"

    "Modified: / 25-02-2000 / 22:32:10 / cg"

    "Modified: / 24-02-2014 / 10:37:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectList methodsFor:'accessing'!

includedPseudoEntryForChanged:something

    includedPseudoEntryForChanged := something.

! !

!ProjectList methodsFor:'aspects'!

itemList

    ^ self projectList value

!

projectLabelHolder

    ^ self pseudoListLabelHolder

!

projectList

    projectList isNil ifTrue:[

	projectList := ValueHolder new.

	projectList addDependent:self.

    ].

    ^ projectList

    "Created: / 17.2.2000 / 23:39:32 / cg"

!

projectNameList

    projectNameList isNil ifTrue:[

        projectNameList := ValueHolder new.

        "/ projectNameList addDependent:self.

    ].

    ^ projectNameList

    "Created: / 17.2.2000 / 23:39:32 / cg"

!

selectedProjects

    ^ self selectionHolder

    "Created: / 17.2.2000 / 23:39:57 / cg"

!

selectedProjects:aValueHolder

    ^ self selectionHolder:aValueHolder

!

selectionIndexHolder

    selectionIndexHolder isNil ifTrue:[

        selectionIndexHolder := 0 asValue.

        selectionIndexHolder addDependent:self.

    ].

    ^ selectionIndexHolder

    "Created: / 17.2.2000 / 23:39:32 / cg"

! !

!ProjectList methodsFor:'change & update'!

delayedUpdate:something with:aParameter from:changedObject

    |cls sel pkg mthd newSel|

    self inSlaveModeOrInvisible 

    "/ (self slaveMode value == true) 

    ifTrue:[

        (changedObject == environment

        or:[ something == #projectOrganization ]) ifTrue:[

            listValid ifFalse:[ ^ self].

            listValid := false

        ].

        changedObject == self selectionHolder ifTrue:[

            selectionIndexValid := false.

        ].

        changedObject == inGeneratorHolder ifTrue:[

            self invalidateList.

            self updateList.

        ].

"/

"/        self window shown ifFalse:[ ^ self ].

    ].

    (changedObject == self selectionHolder) ifTrue:[

        self updateSelectionIndexFromSelection.

        "/ self enqueueDelayedUpdateOutputGenerator.

        ^ self.

    ].

    selectionIndexValid ifFalse:[

        self updateSelectionIndexFromSelection.

    ].

    changedObject == self selectionIndexHolder ifTrue:[

        listValid ifFalse:[

             self updateList.

        ].

        changedObject value == 0 ifTrue:[

            self selectionIndexHolder value:#()

        ].

        newSel := changedObject value collect:[:idx | projectList value at:idx].

        newSel ~= self selectedProjects value ifTrue:[

            self selectedProjects value:newSel.

        ].

        ^ self.

    ].

    changedObject == slaveMode ifTrue:[

        listValid ~~ true ifTrue:[

            self enqueueDelayedUpdateList

        ].

        "/ self invalidateList.

        ^  self

    ].

    changedObject == self projectList ifTrue:[

        ^  self

    ].

    changedObject == environment ifTrue:[

        something == #projectOrganization ifTrue:[

            self invalidateList.

            slaveMode value == true ifFalse:[

                self enqueueDelayedUpdateOutputGenerator.

            ].

            ^ self.

        ].

        something == #methodInClass ifTrue:[

            listValid == true ifTrue:[

                cls := aParameter at:1.

                sel := aParameter at:2.

                mthd := cls compiledMethodAt:sel.

                mthd notNil ifTrue:[

                    pkg := mthd package.

                    (projectList value includes:pkg) ifFalse:[

                        self invalidateList.

                    ]

                ].

            ].

            ^ self

        ].

        (something == #classDefinition

        or:[something == #newClass]) ifTrue:[

            listValid == true ifTrue:[

                cls := aParameter.

                pkg := cls package.

                (projectList value includes:pkg) ifFalse:[

                    self invalidateList.

                ] ifTrue:[

                    self enqueueDelayedUpdateOutputGenerator

                ].

            ] ifFalse:[

                self invalidateList

            ].

            ^ self

        ].

        (something == #classRemove) ifTrue:[

            listValid == true ifTrue:[

                cls := aParameter.

                pkg := cls package.

            ].

        ].

        ^ self

    ].

"/    something == #projectOrganization ifTrue:[

"/        aParameter isSymbol ifTrue:[

"/                    "/ a single method has changed

"/"/                    sel := aParameter.

"/"/                    mthd := changedObject compiledMethodAt:sel.

"/            self enqueueDelayedUpdateOutputGenerator.

"/        ].

"/        ^ self

"/    ].

    changedObject == ChangeSet ifTrue:[

        self invalidateList.

        ^ self

    ].

    (organizerMode notNil

    and:[organizerMode value ~~ #project]) ifTrue:[

        self invalidateList.

        ^ self

    ].

    super delayedUpdate:something with:aParameter from:changedObject

    "Created: / 17-02-2000 / 23:41:02 / cg"

    "Modified: / 17-10-2006 / 18:43:40 / cg"

!

selectionChangedByClick

    "we are not interested in that - get another notification

     via the changed valueHolder"

    self enqueueDelayedUpdateOutputGenerator.

    "Created: / 17.2.2000 / 23:41:17 / cg"

!

update:something with:aParameter from:changedObject

    changedObject == environmentHolder ifTrue:[

        self environmentChanged.

        ^ self.

    ].  

    (self builder isNil or:[self window topView realized not]) ifTrue:[

        "/ ignore those changes while I am invisible

        "/ self makeIndependent.

        listValid := false.

        selectionIndexValid := false.

        ^ self

    ].

    changedObject == environment ifTrue:[

        something == #methodDictionary ifTrue:[

            ^ self 

        ].

        something == #methodTrap ifTrue:[

            ^ self

        ].

        something == #methodCoverageInfo ifTrue:[

            ^ self

        ].

        something == #methodInClass ifTrue:[

            ^ self

        ].

        something == #classVariables ifTrue:[

            ^ self

        ].

        something == #classComment ifTrue:[

            ^ self.

        ].

        something == #methodInClassRemoved ifTrue:[

            ^ self.

        ].

    ].

    super update:something with:aParameter from:changedObject

    "Modified: / 20-07-2011 / 18:54:39 / cg"

    "Modified: / 25-02-2014 / 10:07:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

updateSelectionIndexFromSelection

    |newSel allIdx|

    self selectionHolder value isNil ifTrue:[

        self selectionIndexHolder value:0.

        ^ self.

    ].

    listValid ifFalse:[

         self updateList.

    ].

    allIdx := projectList value indexOf:(self class nameListEntryForALL).

    newSel := self selectionHolder value 

                    collect:[:val | |i|

                                    i := projectList value indexOf:val.

                                    i == 0 ifTrue:[allIdx] ifFalse:[i]]

                    thenSelect:[:idx | idx ~~ 0]. 

    (newSel ~= self selectionIndexHolder value

    or:[ self selectionIndexHolder value == 0]) ifTrue:[

        self selectionIndexHolder value:newSel

    ].

    selectionIndexValid := true.

! !

!ProjectList methodsFor:'drag & drop'!

canDropContext:aDropContext

    |objects package|

    objects := aDropContext dropObjects collect:[:obj | obj theObject].

    (self objectsAreClassFiles:objects) ifTrue:[^ true].

    (objects conform:[:aMethodOrClass | (aMethodOrClass isMethod or:[aMethodOrClass isClass]) ]) ifFalse:[^ false].

    package := self packageAtTargetPointOf:aDropContext.

    package isNil ifTrue:[^ false].

    (objects contains:[:aMethodOrClass | aMethodOrClass package ~= package]) ifFalse:[^ false].

    ^ true

    "Modified: / 17-10-2006 / 18:30:32 / cg"

!

doDropContext:aDropContext

    |package objects methods classes|

    objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].

    (objects conform:[:something | (something isMethod or:[something isClass])]) ifTrue:[

        methods := objects select:[:something | something isMethod].

        classes := objects select:[:something | something isClass].

        package := self packageAtTargetPointOf:aDropContext.

        package notNil ifTrue:[

            methods notEmpty ifTrue:[

                self masterApplication moveMethods:methods toProject:package.

            ].

            classes notEmpty ifTrue:[

                self masterApplication moveClasses:classes toProject:package.

            ]

        ].

        ^ self

    ].

    (objects conform:[:something | something isFilename]) ifTrue:[

        |p|

        p := (self selectedProjects value ? #()) firstIfEmpty:PackageId noProjectID.

        Class packageQuerySignal answer:p

        do:[

            self dropClassFiles:objects.

        ].

        ^ self

    ].

    "Modified: / 17-10-2006 / 18:34:43 / cg"

!

packageAtTargetPointOf:aDropContext

    |p packageListView lineNr item package dropInfo now 

     overItem timeOverItem|

    p := aDropContext targetPoint.

    packageListView := aDropContext targetWidget.

    dropInfo := aDropContext dropInfo.

    lineNr := packageListView yVisibleToLineNr:p y.

    lineNr isNil ifTrue:[^ nil].

    item := projectList value at:lineNr.

    item isNil ifTrue:[^ nil].

    item isString ifTrue:[^ item asSymbol].

    item canExpand ifTrue:[

        now := Timestamp now.

        overItem := dropInfo at:#overItem ifAbsentPut:item.

        timeOverItem := dropInfo at:#timeOverItem ifAbsentPut:[now].

        overItem ~~ item ifTrue:[

            dropInfo at:#timeOverItem put:now.

            dropInfo at:#overItem put:item.

            aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].

        ] ifFalse:[

            (now millisecondDeltaFrom:timeOverItem) >= (UserPreferences current timeToAutoExpandItemsWhenDraggingOver) ifTrue:[

                aDropContext saveDraw:[ item expand. packageListView repairDamage ].

                dropInfo removeKey:#timeOverItem.

                dropInfo removeKey:#overItem.

            ] ifFalse:[

                aDropContext passiveAction:[ self packageAtTargetPointOf:aDropContext ].