"
 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'
	classVariableNames:'AdditionalEmptyProjects'
	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.
"
! !

!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)
          #max: #(#Point 1024 721)
          #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
    ^ #( 
	#(#doubleClickChannel #action )
	immediateUpdate 
	selectedProjects 
	menuHolder 
	outGeneratorHolder 
	inGeneratorHolder 
	selectionChangeCondition
	updateTrigger
	forceGeneratorTrigger
	hideUnloadedClasses
	organizerMode
	slaveMode
       )

    "Created: / 17.2.2000 / 23:46:18 / cg"
    "Modified: / 25.2.2000 / 22:32:10 / cg"
! !

!ProjectList methodsFor:'aspects'!

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 == Smalltalk
        or:[ something == #projectOrganization ]) ifTrue:[ 
            listValid := false
        ].
        ^ self
    ].

    changedObject == self selectionIndexHolder ifTrue:[
        listValid ifFalse:[
             self updateList.
        ].
        newSel := changedObject value collect:[:idx | projectList value at:idx].
        newSel ~= self selectedProjects value ifTrue:[
            self selectedProjects value:newSel.
        ].
        ^ self.
    ].
    changedObject == self selectionHolder ifTrue:[
        listValid == true ifFalse:[
             self updateList.
        ].
        newSel := changedObject value collect:[:val | projectList value indexOf:val].
        newSel ~= self selectionIndexHolder value ifTrue:[
            self selectionIndexHolder value:newSel
        ].
    ].

    changedObject == slaveMode ifTrue:[
        listValid ~~ true ifTrue:[
            self enqueueDelayedUpdateList
        ].
        "/ self invalidateList.
        ^  self
    ].

    changedObject == self projectList ifTrue:[
        ^  self
    ].

    changedObject == Smalltalk ifTrue:[
        something == #projectOrganization ifTrue:[
            self invalidateList.
            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
"/    ].

    (organizerMode notNil
    and:[organizerMode value ~~ #project]) ifTrue:[
        self invalidateList.
        ^ self
    ].
    super delayedUpdate:something with:aParameter from:changedObject

    "Created: / 17.2.2000 / 23:41:02 / cg"
    "Modified: / 26.2.2000 / 01:21:49 / cg"
!

selectionChangedByClick
    "we are not interested in that - get another notification
     via the changed valueHolder"

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

update:something with:aParameter from:changedObject
    changedObject == Smalltalk ifTrue:[
        something == #methodDictionary ifTrue:[
            ^ self 
        ].
        something == #methodTrap 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
! !

!ProjectList methodsFor:'drag & drop'!

canDropContext:aDropContext
    |methodsOrClasses package|

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

    (methodsOrClasses contains:[:aMethodOrClass | (aMethodOrClass isMethod or:[aMethodOrClass isClass]) not]) ifTrue:[^ false].

    package := self packageAtTargetPointOf:aDropContext.
    package isNil ifTrue:[^ false].

    (methodsOrClasses contains:[:aMethodOrClass | aMethodOrClass package ~= package]) ifFalse:[^ false].
    ^ true
!

doDropContext:aDropContext
    |package methodsOrClasses methods classes|

    methodsOrClasses := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
    (methodsOrClasses contains:[:something | (something isMethod or:[something isClass]) not]) ifTrue:[^ self].
    methods := methodsOrClasses select:[:something | something isMethod].
    classes := methodsOrClasses 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.
        ]
    ].
!

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 := packageListView list value at:lineNr.
    item isNil ifTrue:[^ nil].

    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 ].
            ]
        ].
    ].

    package := item package.
    package = self class nameListEntryForALL ifTrue:[^ nil].
    ^ package.
! !

!ProjectList methodsFor:'generators'!

makeGenerator
    "return a generator which enumerates the classes from the selected project(s)."

    |selectedPackages thePackage hideUnloadedClasses|

    selectedPackages := self selectedProjects value.
    selectedPackages size == 0 ifTrue:[
        ^ #()
    ].
    selectedPackages := selectedPackages collect:[:p | p string withoutSeparators].

    hideUnloadedClasses := self hideUnloadedClasses value.

    (selectedPackages includes:(self class nameListEntryForALL)) ifTrue:[
        hideUnloadedClasses ifTrue:[
            ^ Iterator on:[:whatToDo |
                               Smalltalk allClassesDo:[:cls |
                                   cls isLoaded ifTrue:[
                                       (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
                                           whatToDo value:cls
                                       ]
                                   ]
                               ]
                          ]
        ].
        ^ Iterator on:[:whatToDo |
                           Smalltalk allClassesDo:[:cls |
                               (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
                                   whatToDo value:cls
                               ]
                           ]
                      ]
    ].

    selectedPackages size == 1 ifTrue:[
        "/ faster common case
        thePackage := selectedPackages first.

        ^ Iterator on:[:whatToDo | |doInclude|
                           Smalltalk allClassesDo:[:cls |
                               (hideUnloadedClasses not or:[cls isLoaded])
                               ifTrue:[
                                   (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
                                       doInclude := (thePackage = cls package).
                                       doInclude ifFalse:[
                                            cls isJavaClass ifFalse:[
                                               doInclude := (cls methodDictionary contains:[:mthd | thePackage = mthd package])
                                                            or:[ cls class methodDictionary contains:[:mthd | thePackage = mthd package]].
                                            ]
                                       ].
                                       doInclude ifTrue:[
                                           whatToDo value:cls
                                       ]
                                   ]
                               ]
                           ]
                      ]
    ].

    ^ Iterator on:[:whatToDo |  |doInclude|
                       Smalltalk allClassesDo:[:cls |
                           (hideUnloadedClasses not or:[cls isLoaded])
                           ifTrue:[
                               (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
                                   doInclude := (selectedPackages includes:cls package).
                                   doInclude ifFalse:[
                                        cls isJavaClass ifFalse:[
                                           doInclude := (cls methodDictionary contains:[:mthd | selectedPackages includes:mthd package])
                                                        or:[ cls class methodDictionary contains:[:mthd | selectedPackages includes:mthd package]].
                                        ]
                                   ].
                                   doInclude ifTrue:[
                                       whatToDo value:cls
                                   ]
                               ]
                           ]
                       ]
                  ]

    "Created: / 17-02-2000 / 23:49:37 / cg"
    "Modified: / 17-08-2006 / 15:08:32 / cg"
! !

!ProjectList methodsFor:'private'!

allShownProjects
    |allProjects generator|

    allProjects := IdentitySet new.

    inGeneratorHolder isNil ifTrue:[
        (self hideUnloadedClasses value) ifTrue:[
            Smalltalk allClassesDo:[:eachClass |
                |cls pkg|

                eachClass isLoaded ifTrue:[
                    cls := eachClass theNonMetaclass.
                    cls isPrivate ifTrue:[
                        cls := cls topOwningClass
                    ].
                    pkg := cls package ? '__NoProject__'.
                    pkg withoutSeparators size > 0 ifTrue:[
                        allProjects add:pkg asSymbol.
                    ] ifFalse:[
                        "/ for now, nameSpaces are not in any package;
                        "/ this might change. Then, 0-sized packages are
                        "/ illegal, and the following should be enabled.
                        "/ self halt
                    ].
                    cls isJavaClass ifFalse:[
                        cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
                            allProjects add:mthd package asSymbol.
                        ].
                    ].
                ].
            ].
            allProjects := allProjects asOrderedCollection.
        ] ifFalse:[
            allProjects := Smalltalk allProjectIDs.
        ].

        "/ those are simulated - in ST/X, empty projects do not
        "/ really exist; however, during browsing, it makes sense.
        AdditionalEmptyProjects size > 0 ifTrue:[
            "/ remove those that are present ...
            AdditionalEmptyProjects := AdditionalEmptyProjects select:[:pkg | (allProjects includes:pkg) not].
            allProjects addAll:AdditionalEmptyProjects.
        ].
    ] ifFalse:[
        generator := inGeneratorHolder value.
        generator isNil ifTrue:[^ #() ].
        generator do:[:prj | allProjects add:prj].
    ].
    ^ allProjects asOrderedCollection.
!

defaultSlaveModeValue
    |mode|

    mode := self topApplication perform:#initialOrganizerMode ifNotUnderstood:nil.
    mode == OrganizerCanvas organizerModeProject ifTrue:[^ false].
    mode isNil ifTrue:[^ false].
    ^ true
!

initialOrganizerMode
    ^ OrganizerCanvas organizerModeProject
!

listOfProjects
    |allProjects|

    allProjects := self allShownProjects.

    allProjects sort.
    allProjects size == 1 ifTrue:[
        "/ self projectLabelHolder value:(allProjects first , ' [Project]').
        self projectLabelHolder value:(LabelAndIcon icon:(self class packageIcon) string:allProjects first).
    ].
    allProjects size > 1 ifTrue:[
        allProjects addFirst:(self class nameListEntryForALL).
    ].

"/    indent := 0.
"/    1 to:allProjects size do:[:idx |
"/        |this thisC|
"/
"/        this := allProjects at:idx.
"/        thisC := this asCollectionOfSubstringsSeparatedByAny:':/'.
"/
"/        prevC notNil ifTrue:[
"/            (thisC startsWith:prevC) ifTrue:[
"/                indent := indent + 4.
"/            ] ifFalse:[
"/                (thisC copyWithoutLast:1) = (prevC copyWithoutLast:1) ifTrue:[
"/                ] ifFalse:[ 
"/                    indent := (indent - 4) max:0.
"/                ].
"/            ].
"/        ].
"/        allProjects at:idx put:(String new:indent),this.
"/        prevC := thisC.
"/    ].

    ^ allProjects

    "Created: / 17-02-2000 / 23:43:05 / cg"
    "Modified: / 17-08-2006 / 15:08:42 / cg"
!

makeDependent
    Smalltalk addDependent:self

    "Created: / 17.2.2000 / 23:43:13 / cg"
!

makeIndependent
    Smalltalk removeDependent:self.
!

nameListFor:aProjectList
    "
     self basicNew
         nnameListFor:#(
            'bosch:dapasx'
            'bosch:dapasx/a'
            'bosch:dapasx/b'
            'bosch:dapasx/b/1'
            'bosch:dapasx/b/2'
            'bosch:dapasx/c/1'
            'bosch:dapasx/c/2'
            'bosch:dapasy/d/1'
            'bosch:dapasy/d/2'
        )
    "

    |stack|

    stack := OrderedCollection new.

    ^ aProjectList collect:[:this |
        |thisC entry rawEntry prefix indent|

        thisC := this asCollectionOfSubstringsSeparatedByAny:':/'.
        thisC isEmpty ifTrue:[
            thisC := Array with:'<<NULL>>'.
        ].

        [
            |stackTop|

            stack notEmpty
            and:[
                stackTop := stack last.
                (thisC startsWith:stackTop) ifFalse:[
                    stack removeLast.
                    true
                ] ifTrue:[
                    false
                ]]
        ] whileTrue.
        prefix := stack notEmpty ifTrue:[ stack last ] ifFalse:[ #() ].
        indent := stack size * 4.
        stack addLast:thisC.
        prefix isEmpty ifTrue:[
            rawEntry := thisC first , ':' , ((thisC copyFrom:2) asStringWith:$/).
        ] ifFalse:[
            rawEntry := (thisC copyFrom:prefix size+1) asStringWith:$/.
        ].
        entry := (String new:indent) , rawEntry.
        entry.
    ].

    "Created: / 17-02-2000 / 23:43:05 / cg"
    "Modified: / 21-08-2006 / 18:35:55 / cg"
!

release
    super release.

    projectList removeDependent:self.
!

updateList
    |newList oldList newNameList oldNameList oldSelection newSelection selectedProjectsHolder|

    selectedProjectsHolder := self selectedProjects.
    oldSelection := selectedProjectsHolder value.
    newList := self listOfProjects.
    oldList := projectList value.
    newNameList := self nameListFor:newList.
    oldNameList := self projectNameList value.
    (newList ~= oldList
    or:[ newNameList ~= oldNameList]) ifTrue:[
"/        oldSelection size > 0 ifTrue:[
"/            selectedProjectsHolder removeDependent:self.
"/            selectedProjectsHolder value:#().
"/            selectedProjectsHolder addDependent:self.
"/        ].

        self projectList value:newList.
        listValid := true.
        self projectNameList value:newNameList.

        oldSelection size > 0 ifTrue:[
            newSelection := oldSelection select:[:prj | newList includes:prj].
            selectedProjectsHolder value:newSelection.
        ]
    ].
    listValid := true.

    "Modified: / 25.2.2000 / 23:10:01 / cg"
! !

!ProjectList methodsFor:'special'!

addAdditionalProject:aProject
    "/ those are simulated - in ST/X, empty projects do not
    "/ really exist; however, during browsing, it makes sense.
    AdditionalEmptyProjects isNil ifTrue:[
        AdditionalEmptyProjects := Set new.
    ].
    AdditionalEmptyProjects add:aProject.

    Smalltalk changed:#projectOrganization   "/ not really ... to force update

    "Created: / 17.2.2000 / 23:44:27 / cg"
!

removeAdditionalProjects:aListOfProjects
    "/ those are simulated - in ST/X, empty categories do not
    "/ really exist; however, during browsing, it makes sense.
    AdditionalEmptyProjects notNil ifTrue:[
	aListOfProjects do:[:eachProject |
	    AdditionalEmptyProjects remove:eachProject ifAbsent:nil.
	].
    ].
    Smalltalk changed:#projectOrganization   "/ not really ... to force update

    "Created: / 17.2.2000 / 23:45:24 / cg"
! !

!ProjectList class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/Tools_ProjectList.st,v 1.13 2006-08-21 16:37:14 cg Exp $'
! !