'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:'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|

	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:'additional 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

!

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:

			   #('rename'

			     'changes'

			     'browse'

			     'directory'

			     'package'

"

			     '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

    ]

! !