'From Squeakland.396-Nihongo7.29 of 18 March 2005 [latest update: #98] on 29 May 2005 at 4:04:18 pm'!
"Change Set:		ServerTool
Date:			7 December 2004
Author:			Takashi Yamamiya

Easy setting up tool for Super Swiki.
- You can tell squeak where is the server using a dialog easily.
- A 'prefs/knownServers' file for the server is made.
"!

EToyGenericDialogMorph subclass: #ServerTool
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-RemoteDirectory'!

!ServerTool commentStamp: 'tak 12/7/2004 11:31' prior: 0!
I am a simple tool to set up SuperSwiki's location.

ServerTool open.

---
* How to set up your Super Swiki server.
- Get SuperSwiki from http://squeakland.org:8080/super/313.
- Set the port of SuperSwiki and run it on your server.
- Record the address of your machine.
- Pick me up from 'Collaborative' category at the object browser.
- Set the name as you like and the server information like '192.168.0.2:8080'.
!


!ServerTool methodsFor: 'initialize-release' stamp: 'tak 12/7/2004 09:45'!
buttonColor
	^ self defaultBackgroundColor darker darker! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 12/7/2004 09:45'!
buttonNamed: aString action: aSymbol color: aColor help: helpString

	| f col |
	f _ SimpleButtonMorph new
		target: self;
		label: aString font: self myFont;
		color: aColor;
		actionSelector: aSymbol;
		setBalloonText: helpString.
	col _ (self inAColumn: {f}) hResizing: #spaceFill.
	^col! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 5/29/2005 15:29'!
cancelButton

	^self
		buttonNamed: 'Cancel' translated
		action: #delete 
		color: self buttonColor 
		help: 'Cancel this operation.' translated! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 12/7/2004 09:45'!
defaultBackgroundColor
	^ Color
		r: 1.0
		g: 0.806
		b: 0.613! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 5/29/2005 15:30'!
okButton

	^self
		buttonNamed: 'OK' translated
		action: #doOK 
		color: self buttonColor 
		help: 'Apply the name and the server setting.' translated! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 5/29/2005 15:33'!
rebuild
	self removeAllMorphs.
	self color: self defaultBackgroundColor.
	self addARow: {self lockedString: 'Super Swiki server setting' translated}.
	self addARow: {self lockedString: 'Name:' translated. self selectButton. self inAColumnForText: {(self genericTextFieldNamed: 'name') extent: 150 @ 20;
				 setBalloonText: 'Give a name for the server as you like.' translated}}.
	self addARow: {self lockedString: 'Server:' translated. self inAColumnForText: {(self genericTextFieldNamed: 'server') extent: 150 @ 20;
				 setBalloonText: 'Please describe your server setting like "address:port". The server is removed if you make it blank.' translated}}.
	self addARow: {self okButton. self saveButton. self cancelButton}.
	self vResizing: #shrinkWrap;
		 hResizing: #shrinkWrap;
		 layoutInset: 4;
		 useRoundedCorners.
	self borderWidth: 2.
	self borderColor: Color gray.
	self currentName: nil.
! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 5/29/2005 15:29'!
saveButton
	^ self
		buttonNamed: 'Save' translated
		action: #doSave
		color: self buttonColor
		help: 'Save the server setting.' translated! !

!ServerTool methodsFor: 'initialize-release' stamp: 'tak 5/29/2005 15:29'!
selectButton
	^ self
		buttonNamed: 'Select' translated
		action: #doSelect
		color: self buttonColor
		help: 'Select a server from current setting.' translated! !

!ServerTool methodsFor: 'actions' stamp: 'tak 12/7/2004 09:45'!
defaultServer
	^ SuperSwikiServer new type: #http;
		 server: 'localhost:8888';
		 directory: '/super/SuperSwikiProj';
		 acceptsUploads: true! !

!ServerTool methodsFor: 'actions' stamp: 'tak 5/29/2005 16:01'!
doOK
	| name server serverString |
	name := (namedFields at: 'name') contents asString withBlanksTrimmed.
	server := ServerDirectory servers
				at: name
				ifAbsentPut: [self defaultServer].
	serverString := (namedFields at: 'server') contents asString withBlanksTrimmed.
	serverString = ''
		ifTrue: [ServerDirectory servers removeKey: name.
			name := nil]
		ifFalse: [server server: serverString].
	self rebuild.
	self currentName: name.
	server changed: #configurationChanged.
	self delete.! !

!ServerTool methodsFor: 'actions' stamp: 'tak 12/7/2004 12:06'!
doSave
	self doOK.
	ExternalSettings assuredPreferenceDirectory.
	ServerDirectory transferServerDefinitionsToExternal.
	self inform: 'Saved at ' , (ExternalSettings preferenceDirectory directoryNamed: ServerDirectory serverConfDirectoryName) pathName! !

!ServerTool methodsFor: 'actions' stamp: 'tak 12/7/2004 10:23'!
doSelect
	| menu |
	menu _ MenuMorph new defaultTarget: self.
	self currentServers
		keysDo: [:name | menu
				add: name
				target: self
				selector: #currentName:
				argument: name].
	menu popUpInWorld! !

!ServerTool methodsFor: 'accessing' stamp: 'tak 12/7/2004 11:17'!
currentName: aString 
	"Update server information.  
	Make default if nil"
	| assoc |
	assoc _ self pickupServer: aString.
	(namedFields at: 'name')
		contentsWrapped: assoc key.
	(namedFields at: 'server')
		contentsWrapped: assoc value server! !

!ServerTool methodsFor: 'accessing' stamp: 'tak 12/7/2004 10:06'!
currentServers
	"Pick up current SuperSwiki servers"
	"self basicNew currentServers"
	^ ServerDirectory servers
		select: [:server | (server isKindOf: SuperSwikiServer)
				and: [server acceptsUploads]]! !

!ServerTool methodsFor: 'accessing' stamp: 'tak 12/7/2004 11:19'!
pickupServer: aString 
	"self basicNew pickupServer: nil"
	"self basicNew pickupServer: 'Server-BSS'"
	| assoc |
	(aString isNil
			and: [self currentServers size > 0])
		ifTrue: [assoc _ self currentServers atRandom.
			^ assoc].
	(aString notNil
			and: [self currentServers includesKey: aString])
		ifTrue: [^ aString
				-> (self currentServers at: aString)].
	^ 'YourServer' -> self defaultServer! !


!ServerTool class methodsFor: 'instance creation' stamp: 'tak 12/7/2004 09:45'!
open
	^ self new openCenteredInWorld! !

!ServerTool class methodsFor: 'parts bin' stamp: 'tak 12/7/2004 11:25'!
descriptionForPartsBin
	^ self partName:	'Super Swiki Setting'
		categories:		#('Collaborative')
		documentation:	'A Setting panel for Super Swiki'! !