"

 COPYRIGHT (c) 1994 by Claus Gittinger

	      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.

"

StandardSystemView subclass:#ProjectView

	instanceVariableNames:'myProject toggle'

	classVariableNames:'ActiveProjectView'

	poolDictionaries:''

	category:'Interface-Smalltalk'

!

copyright

"

 COPYRIGHT (c) 1994 by Claus Gittinger

	      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

"

    ProjectViews basically offer two functionalities:

      - keep a group of windows in order to organize the desktop

        (I am not sure, if this is really a useful feature, now that we

         have modern windowManagers which have multiple desktops as well).

        All views as created while a project is active are remembered

        and can be hidden/shown altogether.

        (this has nothing to do with windowGroups)

        Also, it is possible to close down all those windows (by destroying the project).

      - keep defaults for various system activities:

                - the fileOut directory (i.e. where the SystemBrowser creates fileOut sources)

                - keep the source module/package

                    thats the default offered when classes are checkedIn the very first time

                - keep a default package-identifier assigned when classes/methods are created/modified.

                    thats mostly useful to browse all classes/methods that have been touched

                    in a projects context

                - keep a per-project changeList

      - allow opening a browser on all classes/methods which were created or modified

        while a project was active.

      - allow opening a browser on this projects changeList (which contains the subset of changes

         which were done while this project was active)

      - allow removal of all classes/methods which have the current projects packageIdentifier

"

! !

for:aProject

    |newView|

    newView := super new.

    newView setProject:aProject.

    ^ newView

    "ProjectView for:(Project new)"

! !

!ProjectView methodsFor:'initialization'!

addToCurrentProject

    "ignored here"

    ^ self

!

initialize

    super initialize.

    "/

    "/ create the toggle ...

    "/

    toggle := Toggle in:self.

    toggle borderWidth:0.

    toggle pressAction:[self showProject].

    toggle releaseAction:[self hideProject].

    "/

    "/ and give it a menu

    "/

    self initializeMenu

    "Created: 25.11.1995 / 18:06:32 / cg"

    "Modified: 10.12.1995 / 00:04:12 / cg"

!

initializeMenu

    |labels selectors m|

    labels := #(

                    'class documentation'

                    '-'

                    'show'

                    'hide'

                    '-'

                    'changes'

                    'browse'

                    'fileOut classes'

                    '-'

                    'fileOut directory ...'

                    'repository module ...'

                    'repository directory ...'

                    'package name ...'

"/                        '-'

"/                        'save project code'

"/                        'build'

                    '-'

                    'remove package code'

                    'remove project'

                    '-'

                    'rename ...'

               ).

     selectors := #(        

                    showClassDocumentation

                    nil

                    showProject

                    hideProject

                    nil

                    browseChanges

                    browsePackage

                    fileOutClasses

                    nil

                    projectDirectory

                    projectModule

                    projectRepository

                    projectPackage

"/                        nil

"/                        saveProjectFiles

"/                        buildProject

                    nil

                    removePackage

                    destroy

                    nil

                    renameProject

                ).

    m := PopUpMenu

                labels:(resources array:labels)

                selectors:selectors

                receiver:self.

    SourceCodeManager isNil ifTrue:[

        m disableAll:#(#projectRepository #projectPackage).

    ].

    toggle middleButtonMenu:m

    "Created: 25.11.1995 / 18:06:32 / cg"

    "Modified: 11.4.1996 / 19:36:26 / cg"

! !

!ProjectView methodsFor:'menu actions'!

browseChanges

    |b|

    b := ChangeSetBrowser openOn:(myProject changeSet).

    b label:(resources string:'Changes in %1' with:myProject name)

!

browsePackage

    "launch browsers for all classes/methods which are defined in this package

     (i.e. whose packageIdentifier is the same as my Projects packageIdentifier)"

    self topView withWaitCursorDo:[

        |classes packageName methods methodList anyClasses anyMethods ignoredClasses|

        anyMethods := anyClasses := false.

        packageName := myProject packageName.

        classes := myProject classes.

        (classes notNil and:[classes notEmpty]) ifTrue:[

            anyClasses := true.

        ].

        methods := myProject individualMethods.

        methods notEmpty ifTrue:[

            anyMethods := true.

            SystemBrowser browseMethods:methods

                                  title:(resources string:'individual methods in package %1' with:packageName).

        ].

        anyClasses ifTrue:[

            SystemBrowser browseClasses:classes

                                  title:(resources string:'classes in package %1' with:packageName).

        ].

        (anyClasses or:[anyMethods]) ifFalse:[

            self information:(resources string:'no classes or methods in this project (yet)')

        ]

    ]

    "Created: 10.12.1995 / 00:08:58 / cg"

    "Modified: 12.12.1995 / 16:35:07 / cg"

!

browseProps

    "will look better, once property inspector runs ..."

    myProject properties inspect

!

buildProject

    self topView withWaitCursorDo:[

	|dir|

	self saveProjectFiles.

	(self confirm:'make object files in: ' ,  dir , ' ?') ifTrue:[

	    myProject buildProject.

	]

    ].

!

destroy

    (myProject views notNil

    and:[myProject views notEmpty]) ifTrue:[

        |box|

        box := YesNoBox new.

        box title:(resources string:'PROJECT_DESTROY') withCRs.

        box okText:(resources string:'yes').

        (box confirm) ifFalse:[^ self]

    ].

    self doDestroy

    "Modified: 12.12.1995 / 16:44:54 / cg"

!

doDestroy

    self hideProject.

    myProject := nil.

    super destroy

!

fileOutClasses

    "fileout all classes belonging to that package.

     CAVEAT: individual methods are not yet supported."

    self topView withWaitCursorDo:[

        |classes packageName methods methodList anyClasses anyMethods ignoredClasses|

        anyMethods := anyClasses := false.

        packageName := myProject packageName.

        classes := myProject classes.

        (classes notNil and:[classes notEmpty]) ifTrue:[

            anyClasses := true.

        ].

        methods := myProject individualMethods.

        methods notEmpty ifTrue:[

            anyMethods := true.

            self warn:'individual methods are currently not handled'

        ].

        anyClasses ifTrue:[

            classes do:[:aClass |

                Transcript showCR:'fileOut: ' , aClass name , ' ...'.

                aClass fileOut

            ].

        ].

        (anyClasses or:[anyMethods]) ifFalse:[

            self information:(resources string:'no classes or methods in this project (yet)')

        ]

    ]

    "Created: 11.4.1996 / 19:29:50 / cg"

!

hideProject

    myProject hideViews.

    ActiveProjectView := nil.

    toggle turnOff.

    Project setDefaultProject.

!

projectDirectory

    |box d|

    box := FilenameEnterBox new.

    box directoriesOnly.

    box title:(resources string:'PROJECT_DIRECTPORY') withCRs.

    (d := myProject directory) notNil ifTrue:[

        box initialText:d

    ].

    box action:[:dirName |

        (OperatingSystem isDirectory:dirName) ifFalse:[

            (OperatingSystem isValidPath:dirName) ifTrue:[

                self warn:(resources string:'%1 is not a valid directory' with:dirName).

                ^ self

            ].

            (self confirm:(resources string:'%1 does not exist\\create ?' with:dirName) withCRs) ifTrue:[

                (OperatingSystem recursiveCreateDirectory:dirName) ifFalse:[

                    self warn:(resources string:'cannot create %1' with:dirName)

                ]

            ].

        ].

        "did it work ?"

        (OperatingSystem isDirectory:dirName) ifTrue:[

            myProject directory:dirName

        ].

    ].

    box showAtPointer

!

projectModule

    |box d|

    box := FilenameEnterBox new.

    box directoriesOnly.

    box title:(resources string:'PROJECT_MODULEDIR') withCRs.

    (d := myProject repositoryModule) notNil ifTrue:[

        box initialText:d

    ].

    box action:[:dirName |

        myProject repositoryModule:dirName

    ].

    box showAtPointer

    "Created: 25.11.1995 / 18:07:51 / cg"

    "Modified: 10.12.1995 / 00:01:25 / cg"

!

projectPackage

    self topView withWaitCursorDo:[

        |box p existingPackages allClasses|

        existingPackages := Set new.

        (allClasses := Smalltalk allClasses) do:[:aClass |

            |p|

            (p := aClass package) notNil ifTrue:[

                existingPackages add:(p asString)

            ].

            aClass methodDictionary do:[:aMethod |

                (p := aMethod package) notNil ifTrue:[

                    existingPackages add:(p asString)

                ]

            ].

            aClass class methodDictionary do:[:aMethod |

                (p := aMethod package) notNil ifTrue:[

                    existingPackages add:(p asString)

                ]

            ].

        ].

        box := ListSelectionBox title:(resources string:'PROJECT_PACKAGENAME') withCRs.

        box list:(existingPackages asOrderedCollection sort).

        (p := myProject packageName) notNil ifTrue:[

            box initialText:p

        ].

        box action:[:packageName |

            |someClass module directory|

            "/ (try) to extract the module & repository directory from someClass which

            "/ is already contained in that package

            Smalltalk allClasses 

                detect:[:cls | 

                                |info|

                                (cls package = packageName) ifTrue:[

                                    (info := cls packageSourceCodeInfo) notNil ifTrue:[

                                        module := info at:#module ifAbsent:nil.

                                        directory := info at:#directory ifAbsent:nil.

                                    ]

                                ].

                                module notNil and:[directory notNil].

                        ]

                ifNone:nil.

            module notNil ifTrue:[

                myProject repositoryModule:module

            ].

            directory notNil ifTrue:[

                myProject repositoryDirectory:directory

            ].

            myProject packageName:packageName.

        ].

        box showAtPointer

    ]

    "Created: 9.12.1995 / 16:50:45 / cg"

    "Modified: 16.8.1996 / 14:56:42 / cg"

!

projectRepository

    |box d|

    box := FilenameEnterBox new.

    box directoriesOnly.

    box title:(resources string:'PROJECT_PACKAGEDIR') withCRs.

    (d := myProject repositoryDirectory) notNil ifTrue:[

        box initialText:d

    ].

    box action:[:dirName |

        myProject repositoryDirectory:dirName

    ].

    box showAtPointer

    "Created: 25.11.1995 / 18:07:51 / cg"

    "Modified: 11.12.1995 / 13:46:53 / cg"

!

removePackage

    "remove all classes and individual methods from the system.

     Currently, this cannot fully restore the state to before

     the time the package was loaded (redefined methods are lost).

     In the future, we may keep a backref of overwritten methods

     and restore them from their source ..."

    |classesToRemove methodsToRemove theProject|

    (myProject isNil

    or:[(theProject := myProject packageName) isNil]) ifTrue:[

        self warn:(resources string:'No current package.').

        ^ self

    ].

    classesToRemove := IdentitySet new.

    methodsToRemove := IdentitySet new.

    Smalltalk allClassesDo:[:aClass |

        |p|

        (p := aClass package) notNil ifTrue:[

            p = theProject  ifTrue:[

                classesToRemove add:aClass

            ]

        ].

    ].

    Smalltalk allClassesDo:[:aClass |

        |p|

        (classesToRemove includes:aClass) ifFalse:[

            aClass methodArray do:[:aMethod |

                (p := aMethod package) notNil ifTrue:[

                    p = theProject  ifTrue:[

                        methodsToRemove add:aMethod

                    ]

                ]

            ].

            aClass class methodArray do:[:aMethod |

                (p := aMethod package) notNil ifTrue:[

                    p = theProject  ifTrue:[

                        methodsToRemove add:aMethod

                    ]

                ]

            ].

        ].

    ].

    (classesToRemove isEmpty

    and:[methodsToRemove isEmpty]) ifTrue:[

        self warn:(resources string:'No classes or methods found in %1' with:theProject).

        ^ self

    ].

    (self confirm:(resources

                        string:'About to remove %1 classes and %2 additional methods.\\Are you certain you want this ?'

                        with:classesToRemove size