--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ProjectLoader.st Fri Jul 01 16:15:32 2011 +0200
@@ -0,0 +1,400 @@
+"
+ COPYRIGHT (c) 2006 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 }"
+
+SimpleDialog subclass:#ProjectLoader
+ instanceVariableNames:'projectList'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Tools'
+!
+
+!ProjectLoader class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 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.
+"
+! !
+
+!ProjectLoader class methodsFor:'initialization'!
+
+initialize
+
+ | item |
+ item := (MenuItem label:'Load project')
+ nameKey:'LoadProject';
+ value:[(Smalltalk at: self fullName asSymbol) open].
+
+ NewLauncher
+ addMenuItem: item
+ from: nil
+ in: 'menu'
+ position: #after
+ space: true.
+
+ "
+ self initialize
+ "
+
+ "Created: / 22-11-2008 / 09:58:03 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 26-11-2008 / 10:00:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader class methodsFor:'accessing'!
+
+projectSites
+
+ ^UserPreferences current projectLoaderProjectSites
+
+ "Created: / 22-11-2008 / 09:13:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 26-11-2008 / 10:13:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader class methodsFor:'defaults'!
+
+defaultProjectFile
+ ^ (Filename homeDirectory construct:'.smalltalk') construct:'projects.rc'
+
+ "Created: / 26-11-2008 / 10:15:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+defaultProjects
+
+ ^#(
+ (
+ 'CellStore'
+ ('cvut:fel/cellstore/core')
+ )
+
+ (
+ 'Perseus'
+ ('cvut:fel/perseus/core'
+ 'cvut:fel/perseus/core_ui'
+ 'cvut:fel/perseus/smallscript'
+ 'cvut:fel/perseus/pascal'
+ 'stx:goodies/xmlsuite/xquery')
+ )
+
+ (
+ 'IZAR'
+ ('cvut:fel/izar')
+ )
+)
+
+ "Created: / 26-11-2008 / 10:06:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader class methodsFor:'interface specs'!
+
+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:Tools::ProjectLoadDialog andSelector:#windowSpec
+ Tools::ProjectLoadDialog new openInterface:#windowSpec
+ Tools::ProjectLoadDialog open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'Select project'
+ name: 'Select project'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 402 301)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (VerticalPanelViewSpec
+ name: 'Main'
+ layout: (LayoutFrame 3 0 3 0 -3 1 -3 1)
+ horizontalLayout: fitSpace
+ verticalLayout: bottomSpaceFit
+ horizontalSpace: 3
+ verticalSpace: 3
+ component:
+ (SpecCollection
+ collection: (
+ (SelectionInListModelViewSpec
+ name: 'ProjectList'
+ model: projectSelectionHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ listModel: projectNamesHolder
+ highlightMode: line
+ doubleClickSelector: doAccept
+ extent: (Point 390 240)
+ )
+ (ActionButtonSpec
+ label: 'Update list from network'
+ name: 'Update'
+ translateLabel: true
+ model: doUpdateFromNetwork
+ initiallyDisabled: false
+ useDefaultExtent: true
+ )
+ (HorizontalPanelViewSpec
+ name: 'ButtonPanel'
+ horizontalLayout: fit
+ verticalLayout: fitSpace
+ horizontalSpace: 3
+ verticalSpace: 3
+ component:
+ (SpecCollection
+ collection: (
+ (ActionButtonSpec
+ label: 'Cancel'
+ name: 'CancelButton'
+ translateLabel: true
+ model: doCancel
+ useDefaultExtent: true
+ )
+ (ActionButtonSpec
+ label: 'Load'
+ name: 'LoadButton'
+ translateLabel: true
+ model: doAccept
+ enableChannel: canDoAcceptHolder
+ useDefaultExtent: true
+ )
+ )
+
+ )
+ useDefaultExtent: true
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 26-11-2008 / 09:16:59 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader class methodsFor:'load & save'!
+
+loadProjects
+ |projectFile|
+
+ projectFile := self defaultProjectFile.
+ projectFile exists ifFalse:[
+ ^ self defaultProjects
+ ].
+ ^ Compiler
+ evaluate:projectFile contents asString
+ ifFail:[ self defaultProjects ].
+
+ "
+ self projectList"
+
+ "Created: / 22-11-2008 / 09:41:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 26-11-2008 / 10:17:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+saveProjects:projects
+ |projectFile|
+
+ projectFile := self defaultProjectFile.
+ projectFile writeStream nextPutAll:projects storeString
+
+ "Created: / 26-11-2008 / 10:07:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader methodsFor:'actions'!
+
+doAccept
+
+ | packages |
+ self canDoAcceptHolder value ifFalse:[^self].
+ packages := (projectList at: self projectSelectionHolder value) second.
+ packages do:
+ [:pkg|Smalltalk loadPackage: pkg].
+ super doAccept.
+
+ "Created: / 22-11-2008 / 09:55:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+doUpdateFromNetwork
+ <resource: #uiCallback>
+
+ | projects newProjects |
+ projects := self class loadProjects asOrderedCollection.
+ self class projectSites do:
+ [:site|
+ | siteUrl response |
+ siteUrl := site asURL.
+ response := HTTPInterface get: siteUrl path fromHost: siteUrl host.
+ newProjects := Compiler evaluate: response data ifFail:[#()].
+ newProjects do:
+ [:newPrj|
+ | oldPrj |
+ oldPrj := projects
+ detect:[:oldPrj|oldPrj first = newPrj first]
+ ifNone:[projects add: newPrj].
+ oldPrj at:2 put: newPrj second.
+ ]
+ ].
+ projects := projects asArray.
+
+ projectList := projects.
+ self class saveProjects: projects.
+ self projectListChanged
+
+
+ "
+ Tools::ProjectLoadDialog new doUpdateFromNetwork
+
+ "
+
+ "Modified: / 26-11-2008 / 10:28:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader methodsFor:'aspects'!
+
+canDoAcceptHolder
+ <resource: #uiAspect>
+
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+ "*** (and replace this comment by something more useful ;-)"
+
+ |holder|
+
+ (holder := builder bindingAt:#canDoAcceptHolder) isNil ifTrue:[
+ holder := false asValue.
+ builder aspectAt:#canDoAcceptHolder put:holder.
+"/ if your app needs to be notified of changes, uncomment one of the lines below:
+"/ holder addDependent:self.
+"/ holder onChangeSend:#canDoAcceptHolderChanged to:self.
+ ].
+ ^ holder.
+
+ "Created: / 22-11-2008 / 09:51:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+projectNamesHolder
+ <resource: #uiAspect>
+
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+ "*** (and replace this comment by something more useful ;-)"
+
+ |holder|
+
+ (holder := builder bindingAt:#projectNamesHolder) isNil ifTrue:[
+ holder := #() asValue.
+ builder aspectAt:#projectNamesHolder put:holder.
+"/ if your app needs to be notified of changes, uncomment one of the lines below:
+"/ holder addDependent:self.
+"/ holder onChangeSend:#projectNamesHolderChanged to:self.
+ ].
+ ^ holder.
+
+ "Created: / 22-11-2008 / 08:59:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+projectSelectionHolder
+ <resource: #uiAspect>
+
+ "automatically generated by UIPainter ..."
+
+ "*** the code below creates a default model when invoked."
+ "*** (which may not be the one you wanted)"
+ "*** Please change as required and accept it in the browser."
+ "*** (and replace this comment by something more useful ;-)"
+
+ |holder|
+
+ (holder := builder bindingAt:#projectSelectionHolder) isNil ifTrue:[
+ holder := ValueHolder new.
+ builder aspectAt:#projectSelectionHolder put:holder.
+"/ if your app needs to be notified of changes, uncomment one of the lines below:
+ holder addDependent:self.
+ holder onChangeSend:#projectSelectionHolderChanged to:self.
+ ].
+ ^ holder.
+
+ "Created: / 22-11-2008 / 08:59:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader methodsFor:'change & update'!
+
+projectListChanged
+
+ self projectNamesHolder value:
+ (projectList collect:[:prj|prj first])
+
+ "Created: / 22-11-2008 / 09:52:47 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+projectSelectionHolderChanged
+
+ | selection |
+ selection := self projectSelectionHolder value.
+
+ self canDoAcceptHolder value:
+ (selection notNil and:[selection ~= 0])
+
+ "Created: / 22-11-2008 / 09:52:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader methodsFor:'hooks'!
+
+commonPostOpen
+
+ projectList := self class loadProjects.
+ self projectListChanged
+
+ "Created: / 22-11-2008 / 09:43:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 26-11-2008 / 10:16:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!ProjectLoader class methodsFor:'documentation'!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__ProjectLoader.st,v 1.1 2011-07-01 14:15:32 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: Tools__ProjectLoader.st 7486 2009-10-26 22:06:24Z vranyj1 §'
+! !
+
+ProjectLoader initialize!