[SCRIPT] Setting up a 3.9 image for developers

Torsten Bergmann astares at gmx.de
Wed Jul 12 13:29:47 UTC 2006


Hi,

attached is a loader script I use to prepare an image to do Seaside work.

Download a new 3.9b#7039  from http://ftp.squeak.org/3.9 and just file it in.
Evaluate the code in the provided workspace, answer all questions with "yes"
and enter your config user and password.

It downloads RefactoringBrowser, Shout, eCompletion, ScriptManager with Shout, Techo,
TestBrowser, KomHttpServer and loads the latest Seaside 2.6b1 stream

Note that after installation you can:
 - use all the tools from the open menu 
 - open an image with the file list and select it as desktop background
 - use ALT+W to switch windows 
 - start a KOM webserver by evaluating "Webserver start" 
   (by default it runs on port 9096 and serves all files from a subdirectory called "resources"
   in the image folder - this is similar to the structure required for seasidehosting.st)
 - if you work on Win32 you can evaluate
      "Webserver openApplication: 'config'" top open up the configuration or 
      "Webserver openApplication: 'myapp'" top open a browser on your application
    
Customization:
- if you work behind a firewall uncomment the line in #setProxyServer and add your proxy
- see #setMonticelloRepositories to automatically add repositories for your own projects
  after installation
  
Have fun
Torsten
-- 


Der GMX SmartSurfer hilft bis zu 70% Ihrer Onlinekosten zu sparen!
Ideal für Modem und ISDN: http://www.gmx.net/de/go/smartsurfer
-------------- next part --------------
Object subclass: #DEVImageInstaller
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DEVImageInstaller'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

DEVImageInstaller class
	instanceVariableNames: ''!

!DEVImageInstaller class methodsFor: 'class initialization' stamp: 'tbn 6/22/2006 17:41'!
initialize
	"Initializes the receiver"
	
	(Workspace new contents: 'DEVImageInstaller install') openLabel: 'Evaluate to install'! !

!DEVImageInstaller class methodsFor: 'class initialization' stamp: 'tbn 6/22/2006 17:12'!
install
	"Install the system
	
		DEVImageInstaller install
	"
	
	self prepareImage.
! !


!DEVImageInstaller class methodsFor: 'defaults' stamp: 'tbn 6/22/2006 17:26'!
packagesToLoad

	^#(('mcz' 'AST' 'http://www.squeaksource.com/AST')
	   ('mcz' 'RefactoringEngine' 'http://www.squeaksource.com/RefactoringEngine')
	   ('mcz' 'RoelType' 'http://www.squeaksource.com/RoelTyper')
	   ('mcz' 'TestBrowser' 'http://www.squeaksource.com/DeveloperWorkspace/')	
	   ('sm'  'Shout' '5')	
	   ('sm'  'ShoutWorkspace' '2')
	   ('sm'  'ECompletion' '6')	
	   ('sm'  'ODBC for Squeak' '1')	
	   ('mcz' 'Techo-Base' 'http://www.squeaksource.com/DeveloperWorkspace/')
	   ('sm'  'Script Manager' '1')	   
	   ('sm'  'ScriptManager Shout' '1')	
	   ('sm'  'MemoryUsage' '3')
	   ('sm'  'KeyBinder' '3')
	   ('sm'  'DynamicBindings' '2')
	   ('sm'  'KomServices' '4')
	   ('sm'  'KomHttpServer' '5')
	   ('sm'  'Background Loader' '1')	   
	   ('mcz' 'Seaside2.6b1' 'http://www.squeaksource.com/Seaside/')
	   ('mcz' 'Webserver' 'http://www.squeaksource.com/DeveloperWorkspace/')
	)
! !


!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 17:11'!
askForInitials

	Utilities setAuthorInitials:
		(UIManager default request: 'Please type your initials: ' translated
					initialAnswer: 'tbn')! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 17:35'!
prepareImage
	"Prepare the image"
		
	self
		askForInitials;
		setProxyServer;
		setFonts;
		installPackages;
		setDisplayDepth;
		setFullScreen;
		setKeys;
		setPreferences;
		clearScreen;
		stopProxyServer;
		registerScriptManagerInWorldMenu;		
		setMonticelloRepositories;		
		openMonticelloBrowser! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:08'!
setDisplayDepth
	"Sets the display depth to 32bit"

	Display newDepth: 32.! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:22'!
setFonts
	| textStyle font |
	textStyle := TextStyle named: #BitstreamVeraSans.
	font := textStyle fontOfPointSize: 9.
	Preferences 
		setListFontTo: font;
		setCodeFontTo: font;
		setMenuFontTo: font;
		setBalloonHelpFontTo: font! !


!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:14'!
registerScriptManagerInWorldMenu
	"Register the script manager in world menu"
	(TheWorldMenu respondsTo: #registerOpenCommand:)
		ifTrue: [TheWorldMenu registerOpenCommand: {'ScriptManager'. {(Smalltalk at: #ScriptManager). #open}}]
! !


!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:14'!
setFullScreen

	Display fullScreenMode: true! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:16'!
setKeys
	Preferences setPreference: #duplicateControlAndAltKeys toValue: true.
! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:11'!
setPreferences
	Preferences setPreference: #projectViewsInWindows toValue: false.
	Preferences setPreference: #showSharedFlaps toValue: false.
	Preferences setPreference: #syntaxHighlightingAsYouTypeAnsiAssignment toValue: true.
	SystemBrowser default: (Smalltalk at: #RefactoringBrowser).
! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:12'!
clearScreen
	World submorphsDo:[:m| (m isKindOf: KeyBinder) ifFalse: [m delete]].
	(Smalltalk at: #KeyBinder) allInstances isEmpty ifTrue: [(Smalltalk at: #KeyBinder) open].
	(Smalltalk at: #KeyBinder) allInstances do: [:each | each visible: false].
	World color: (Color fromString: #ffffce)
! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:12'!
setMonticelloRepositories
	"Add your own squeaksource or local squeaksource repositories here"
	#(
	   'MCHttpRepository    location: ''http://www.squeaksource.com/MyProject''    user: ''squeak''    password: ''pass'''
	   'MCHttpRepository    location: ''http://localhost/MyLocalSqueakSourceProject''    user: ''squeak''    password: ''pass'''
	) do: [:chunk |
		|repo|
		repo := MCHttpRepository readFrom: chunk readStream.
		repo creationTemplate: chunk.
		MCRepositoryGroup default addRepository: repo
	]
! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:12'!
openMonticelloBrowser
	MCWorkingCopyBrowser open
! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 14:06'!
setProxyServer
	"uncomment if you have work behind proxy server"
	
	"HTTPSocket useProxyServerNamed: '000.000.00.00' port: 0000."
! !

!DEVImageInstaller class methodsFor: 'image preparation' stamp: 'tbn 6/22/2006 17:35'!
stopProxyServer
	HTTPSocket stopUsingProxyServer! !


!DEVImageInstaller class methodsFor: 'installation' stamp: 'tbn 6/22/2006 15:09'!
installPackages
	SMSqueakMap default loadUpdates.
	self packagesToLoad do: [:each |
		self load: each
	]
! !

!DEVImageInstaller class methodsFor: 'installation' stamp: 'tbn 6/22/2006 15:31'!
load: loadSpec
	| method file param |
	method := loadSpec first.
	file := loadSpec second.
	param := loadSpec third.
	method = 'mcz' ifTrue: [^self loadPackage: file fromRepository: param].
	method = 'sm' ifTrue: [^self loadSqueakMapPackage: file version: param].
	
	! !


!DEVImageInstaller class methodsFor: 'private' stamp: 'tbn 6/22/2006 14:36'!
splitOnPeriod: aString

	| lines |
	lines := aString
				copyReplaceAll: '.'
				with: String cr
				asTokens: false.

	^ Array streamContents: [:stream | lines linesDo: [:each | stream nextPut: each]]! !


!DEVImageInstaller class methodsFor: 'private accessing' stamp: 'tbn 6/22/2006 14:26'!
mczSortBlock

	^[:a :b |
		[(self splitOnPeriod: a) allButLast last asInteger > (self splitOnPeriod: b) allButLast last asInteger]
		on: Error do: [:ex | false]].
	 ! !


!DEVImageInstaller class methodsFor: 'private installation' stamp: 'tbn 6/22/2006 15:13'!
loadPackage: packageName fromRepository: url
 
	| repository fileToLoad monticelloFiles version |
	repository := MCHttpRepository location: url user: '' password: ''.	
	monticelloFiles := repository readableFileNames asSortedCollection: self mczSortBlock.
	fileToLoad := monticelloFiles detect:
			[:file | file beginsWith: packageName].
	version := repository versionFromFileNamed: fileToLoad.
	version load
	! !

!DEVImageInstaller class methodsFor: 'private installation' stamp: 'tbn 6/22/2006 15:29'!
loadSqueakMapPackage: packageName version: version
 
	SMSqueakMap default
		installPackageNamed: packageName
		autoVersion: version ! !

!StandardToolSet class methodsFor: 'menu' stamp: 'tbn 7/6/2006 10:51'!
openWorkspace
	(Smalltalk at: #SHWorkspace ifAbsent: [Workspace]) open
	
! !		

DEVImageInstaller initialize!


More information about the Squeak-dev mailing list