"
 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'
!

!ProjectView class methodsFor:'documentation'!

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 some project was 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
"
! !

!ProjectView class methodsFor:'instance creation'!

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|

    SourceCodeManager isNil ifTrue:[
	labels := #(
			'rename ...'
			'-'
			'changes'
			'browse'
			'-'
			'fileOut directory ...'
			'package name ...'
			'-'
			'show'
			'hide'
			'-'
			'remove package classes/methods'
			'destroy'
		   ).

	 selectors := #(        
			renameProject
			nil
			browseChanges
			browsePackage
			nil
			projectDirectory
			projectPackage
			nil
			showProject
			hideProject
			nil
			removePackage
			destroy
		    )
    ] ifFalse:[
	labels := #(
			'rename ...'
			'-'
			'changes'
			'browse'
			'-'
			'fileOut directory ...'
			'repository module ...'
			'repository directory ...'
			'package name ...'
"/                        '-'
"/                        'save project code'
"/                        'build'
			'-'
			'show'
			'hide'
			'-'
			'remove package code'
			'destroy'
		   ).

	 selectors := #(        
			renameProject
			nil
			browseChanges
			browsePackage
			nil
			projectDirectory
			projectModule
			projectRepository
			projectPackage
"/                        nil
"/                        saveProjectFiles
"/                        buildProject
			nil
			showProject
			hideProject
			nil
			removePackage
			destroy
		    )
    ].

    toggle middleButtonMenu:(
	PopUpMenu
		labels:labels
		selectors:selectors
		receiver:self
    )

    "Created: 25.11.1995 / 18:06:32 / cg"
    "Modified: 10.12.1995 / 00:05:41 / cg"
! !

!ProjectView methodsFor:'menu actions'!

browseChanges
    |b|

    b := ChangeSetBrowser openOn:(myProject changeSet).
    b label:'Changes in ' , myProject name
!

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

    self topView withWaitCursorDo:[
	|classes packageName methods methodList|

	packageName := myProject packageName.
	classes := myProject classes.
	(classes notNil and:[classes notEmpty]) ifTrue:[
	    SystemBrowser browseClasses:classes
				  title:'classes in package ' , packageName.

	    classes := classes asIdentitySet.
	    classes addAll:(classes collect:[:c | c class]).
	] ifFalse:[
	    classes := #()
	].
"/        SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
"/                                    mthd package = packageName
"/                                    and:[(classes includes:cls) not]
"/                                  ] 
"/                            title:'individual methods in package ' , packageName.

	methods := myProject individualMethods.
	methodList := methods collect:[:m | 
					|who|

					who := m who.
					(who at:1) name , ' ' , (who at:2)
				      ].
	methodList notEmpty ifTrue:[
	    SystemBrowser browseMethods:methodList
				  title:'individual methods in package ' , packageName.
	]
    ]

    "Created: 10.12.1995 / 00:08:58 / 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:'Destroying a project will discard all changes made
for that project and destroy all views opened for it.

Do you really want to do this ?'.
	box okText:'yes'.
	(box confirm) ifFalse:[^ self]
    ].

    self doDestroy
!

destroyProject
    |box|

    box := YesNoBox new.
    box title:'Destroying a project will discard all changes made
for that project and destroy all views opened for it.

Do you really want to do this ?'.
    box okText:'yes'.
    box yesAction:[
	self doDestroyProject
    ].
    box showAtPointer
!

doDestroy
    self hideProject.
    myProject := nil.
    super destroy
!

hideProject
    myProject hideViews.
    ActiveProjectView := nil.
    toggle turnOff.
    Project setDefaultProject.
!

projectDirectory
    |box d|

    box := FilenameEnterBox new.
    box directoriesOnly.
    box title:(resources string:'Directory of project (fileOuts will go there):').
    (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:'Module in repository (new source containers / packages will go there):').
    (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 methodArray do:[:aMethod |
		(p := aMethod package) notNil ifTrue:[
		    existingPackages add:(p asString)
		]
	    ].
	    aClass class methodArray do:[:aMethod |
		(p := aMethod package) notNil ifTrue:[
		    existingPackages add:(p asString)
		]
	    ].
	].

	box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
	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: 10.12.1995 / 00:10:04 / cg"
!

projectRepository
    |box d|

    box := FilenameEnterBox new.
    box directoriesOnly.
    box title:(resources string:'Relative path of package in repository (new source containers will go there):').
    (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:'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:('Nothing found in ' , theProject).
	^ self
    ].

    (self confirm:('About to remove '
		 , classesToRemove size printString
		 , ' classes and '
		 , methodsToRemove size printString
		 , ' additional methods.\\Are you certain you want this ?') withCRs)
	ifTrue:[
	    classesToRemove do:[:aClass |
		('PROJECT: removing ' , aClass name) infoPrintNL.
		Smalltalk removeClass:aClass.   
	    ].
	    methodsToRemove do:[:aMethod |
		|where|

		('PROJECT: removing ' , aMethod displayString) infoPrintNL.
		where := aMethod who.
		where isNil ifTrue:[
		    'PROJECT: oops, some method is gone' infoPrintNL.
		] ifFalse:[
		    (where at:1) removeSelector:(where at:2)
		]
	    ]
    ].
!

renameProject
    |box|

    box := EnterBox new.
    box title:'new name of project:'.
    box okText:'rename'.
    box initialText:(myProject name).
    box action:[:newName |
	myProject name:newName.
	self setProject:myProject.
	self windowGroup process name:'Project: ' , newName.
    ].
    box showAtPointer
!

saveProjectFiles
    self topView withWaitCursorDo:[
	|dir|

	dir := myProject directory.
	(self confirm:'create source files in: ' ,  dir , ' ?') ifTrue:[
	    myProject createProjectFiles.
	]
    ].
!

showProject
    ActiveProjectView notNil ifTrue:[
	ActiveProjectView hideProject
    ].
    ActiveProjectView := self.

    myProject showViews.
    Project current:myProject.
    toggle turnOn
! !

!ProjectView methodsFor:'private accessing'!

setProject:aProject
    |name e|

    name := aProject name.
    self label:name.
    self iconLabel:name.
    toggle label:'Project: ' , name.
    toggle resize.
    myProject := aProject.
    e := (toggle width @ toggle height).
    drawableId isNil ifTrue:[
	self minExtent:e.
	self maxExtent:e.
	self open
    ] ifFalse:[
	self unrealize.
	self minExtent:e.
	self maxExtent:e.
	self extent:e.
	self rerealize
    ]
! !

!ProjectView class methodsFor:'documentation'!

version
^ '$Header: /cvs/stx/stx/libtool/Attic/ProjectV.st,v 1.24 1995-12-12 12:23:08 cg Exp $'! !