"

 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.

"

'From Smalltalk/X, Version:2.10.4 on 5-feb-1995 at 11:48:18 pm'!

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.

"

!

version

"

"

! !

!ProjectView class methodsFor:'instance creation'!

for:aProject

    |newView|

    newView := super new.

    newView setProject:aProject.

    ^ newView

    "ProjectView for:(Project new)"

! !

!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 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)

				      ].

	SystemBrowser browseMethods:methodList

			      title:'individual methods in package ' , packageName.

    ]

!

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

!

projectPackage

    self topView withWaitCursorDo:[

	|box p existingPackages|

	existingPackages := Set new.

	Smalltalk allClassesDo:[:aClass |

	    |p|

	    (p := aClass package) notNil ifTrue:[

		existingPackages add:(p asString)

	    ]

	].

	Method allInstancesDo:[:aClass |

	    |p|

	    (p := aClass 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 |

	    myProject packageName:packageName

	].

	box showAtPointer

    ]

!

showProject

    ActiveProjectView notNil ifTrue:[

	ActiveProjectView hideProject

    ].

    ActiveProjectView := self.

    myProject showViews.

    Project current:myProject.

    toggle turnOn

!

browseProps

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

    myProject properties inspect

!

saveProjectFiles

    self topView withWaitCursorDo:[

	|dir|

	dir := myProject directory.

	(self confirm:'create source files in: ' ,  dir , ' ?') ifTrue:[

	    myProject createProjectFiles.

	]

    ].

!

hideProject

    myProject hideViews.

    ActiveProjectView := nil.

    toggle turnOff.

    Project setDefaultProject.

!

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

!

buildProject

    self topView withWaitCursorDo:[

	|dir|

	self saveProjectFiles.

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

	    myProject buildProject.

	]

    ].

!

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

!

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

! !

!ProjectView methodsFor:'initialization'!

initialize

    super initialize.

    toggle := Toggle in:self.

    toggle borderWidth:0.

    toggle pressAction:[self showProject].

    toggle releaseAction:[self hideProject].

    toggle middleButtonMenu:(

	PopUpMenu

		labels:(resources array:

			     'changes'

			     'browse'

"

			     'properties'

"

			     '-'

			     'save project code'

			     'build'

			     '-'

			     'show'

			     'hide'

			     '-'

			     'destroy'

			    )

			)

	     selectors:#(renameProject

			 browseChanges

			 browsePackage

			 projectDirectory

			 projectPackage

"

			 browseProps

"

			 nil

			 saveProjectFiles

			 buildProject

			 nil

			 showProject

			 hideProject

			 nil

			 destroy

			)

	      receiver:self

    )

!

addToCurrentProject

    "ignored here"

    ^ self

! !

!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

    ]

! !