Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Diego Gomez Deck - development tools
Last updated at 1:33 pm UTC on 4 November 2017
https://web.archive.org/web/20090612095854/http://wiki.gnulinex.org:80/LibroProgramacionSmalltalk/5



Example script for setting up a specialized image:


DevelopmentStartup-dgd.cs: Script que convierte una imagen 3.8 'virgen' en una imagen para el libro.


'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 25 November 2005 at 2:18:54 pm'!
"Change Set:		DevelopmentStartup-dgd
Date:			21 September 2005
Author:			Diego Gomez Deck

Transform a 3.8 full 'virgin' image into a development-image.

Tested in Squeak3.8-6665-full.zip

"
!

Object subclass: #SmallLandDevelopment
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SmallLand-Development'!

!SMSqueakMap methodsFor: '*SmallLand-Development-public-installation' stamp: 'dgd 9/21/2005 12:12'!
installPackageNamed: aString version: version
	"Install the release <version> of the package with a name beginning with aString (see method comment of #packageWithNameBeginning:).
	<version> is the version name."

	| p r |
	p := self packageWithNameBeginning: aString.
	p ifNil: [self error: 'No package found with name beginning with ', aString].
	r := p releaseWithVersion: version.
	r ifNil: [self error: 'No package release found with version ', version].
	^self installPackageRelease: r! !


!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 11/25/2005 14:10'!
apply
	self deleteAllWindows.

	self deleteWindowLabeled: 'Transcript'.

	World findATranscript: nil.
	Transcript clear.

	self log: 'Removing flaps...'.
	Flaps disableGlobalFlaps: false.

	self log: 'Cleaning world...'.
	self cleanWorld.

	self log: 'Applying preferences...'.
	self applyPreferences.

	self log: 'Changing fonts...'.
	self applyFonts.

	self log: 'Changing colors...'.
	self applyColors.

	self log: 'Installing packages...'.
	self installPackages.

	self log: 'Configuring packages...'.
	self configurePackages.

	self log: 'Layout world...'.
	self layoutWorld.

	self log: 'Done!!'.
! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 9/22/2005 12:24'!
applyColors
	Preferences installBrightWindowColors.

	"apply the receiver as the current theme"
	BalloonMorph setBalloonColorTo: (Color white alpha: 0.95).
	""
	"Preferences setParameter: #defaultWorldColor to: (Color r: 1.0 g: 1.0 b: 0.919)."
	""
	Preferences insertionPointColor: (Color r: 1.0 g: 0.0 b: 0.7).
	Preferences keyboardFocusColor: (Color r: 1.0 g: 0.05 b: 0.0).
	Preferences textHighlightColor: (Color r: 1.0 g: 0.8 b: 0.0).
	""
	Preferences setParameter: #menuTitleColor to: (Color r: 0.0 g: 0.8 b: 0.599).
	Preferences setParameter: #menuTitleBorderColor to: (Color r: 0.0 g: 0.8 b: 0.599).
	Preferences setParameter: #menuTitleBorderWidth to: 6.
	Preferences setParameter: #menuColor to: Color lightYellow.
	Preferences setParameter: #menuBorderColor to: (Color r: 0.8 g: 0.4 b: 0.0).
	Preferences setParameter: #menuLineColor to: (Color r: 1.0 g: 0.8 b: 0.0).
	Preferences setParameter: #menuBorderWidth to: 2.
	Preferences setParameter: #menuSelectionColor to:  (Color r: 0.8 g: 0.4 b: 0.0).

	Project current == Project topProject
		ifTrue: [World color: (Color r: 1.0 g: 1.0 b: 0.9)].

! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 9/21/2005 13:20'!
applyFonts
	"private - change the fonts to small-land's choices"

	#(
		(setButtonFontTo:			#BitstreamVeraSansMono	12)

		(setListFontTo:				#BitstreamVeraSans			12)
		(setMenuFontTo:			#BitstreamVeraSans			12)
		(setSystemFontTo:			#BitstreamVeraSans			12)

		(setWindowTitleFontTo:	#BitstreamVeraSans			15)

		(setCodeFontTo:			#BitstreamVeraSerif			12)

 	)
		do: [:triplet |
			Preferences
				perform: triplet first
				with: (StrikeFont familyName: triplet second pointSize: triplet third)
		].

	BalloonMorph setBalloonFontTo: (StrikeFont familyName: #BitstreamVeraSans pointSize: 12).

"
		(setFlapsFontTo:					#KomikaText					15)
		(setEToysFontTo:				#KomikaText					15)
		(setHaloLabelFontTo:			#KomikaText					15)
		(setEToysTitleFontTo:			#KomikaText					24)
"
! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 9/21/2005 13:21'!
applyPreferences
	"Private - change the preferences according to small-land taste"

	Preferences setPreferencesFrom: #(
		(haloEnclosesFullBounds 			true)
		(showBoundsInHalo       				true)
		(cmdGesturesEnabled				false)
		(easySelection							true)
		(abbreviatedBrowserButtons		true)
		(alternativeBrowseIt					true)
		(alwaysShowVScrollbar            		false)
		(annotationPanes                 			true)
		(balloonHelpInMessageLists       	true)
		(browseWithDragNDrop             		true)
		(classicNewMorphMenu             		true)
		(collapseWindowsInPlace          		true)
		(dragNDropWithAnimation          	true)
		(duplicateControlAndAltKeys      	true)
		(extraDebuggerButtons            		true)
		(extractFlashInHighestQuality    	true)
		(fastDragWindowForMorphic        	false)
		(includeSoundControlInNavigator	true)
		(menuKeyboardControl				true)

		(mouseOverForKeyboardFocus		true)
		(optionalButtons                 			true)
		(preserveTrash                   			true)
		(projectViewsInWindows				true)
		(propertySheetFromHalo				true)
		(scrollBarsNarrow						true)
		(scrollBarsOnRight					true)
		(selectiveHalos							true)
		(showDirectionForSketches			true)
		(showDirectionHandles				true)
		(slideDismissalsToTrash				true)
		(translationWithBabel				true)
		(unlimitedPaintArea					true)

		(menuColorFromWorld				false)
		(uniqueNamesInHalos				true)
		(infiniteUndo							true)
		(useUndo								true)
		(soundStopWhenDone				true)

		(menuAppearance3d					false)
		(gradientMenu							false)
		(showSplitterHandles					false)
		(resizeOnAllSides						true)

	).

	Preferences setParameter: #balloonHelpDelayTime to: 100.

"
		(noviceMode					true)
		(browseWithPrettyPrint	true)
		(colorWhenPrettyPrinting	true)
		(diffsWithPrettyPrint		true)
		(eToyFriendly				true)
"
! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 11/25/2005 14:06'!
cleanWorld
	| windowsToDelete |

	self deleteProjectNamed: 'SmalltalkIntroduction'.

	windowsToDelete := #('Welcome to...' 'ReadMe.txt' 'A note to students, parents, and teachers').
	windowsToDelete do: [:eachLabel | self deleteWindowLabeled: eachLabel].

	World submorphs
		select:[:each | each externalName = 'SqueakLogo']
		thenDo:[:each | each delete].
! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 11/25/2005 14:09'!
configurePackages
	"private - configure the (posible) just installed packages"
	
	Smalltalk
		at: #WAKom
		ifPresent:[:waKom | waKom startOn: 9090].

	(SystemWindow
		windowsIn: World
		satisfying: [:each | each label = 'Useful code snippets'])
			do: [:each |
					each isCollapsed ifTrue: [each expand].
					each submorphs second accept.
					each delete].

	(SHWorkspace new contents: 'Transcript clear.

"Start Seaside"
WAKom startOn: 9090.

"Check seaside configuration at: http://localhost:9090/seaside/config"

"Apply the Small-Land changes"
SmallLandDevelopment new apply.

') openLabel: 'Useful code snippets'.

	self configureShoutColors.
! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 9/23/2005 11:29'!
configureShoutColors
	"
	SmallLandDevelopment new configureShoutColors.
	"

	SHTextStylerST80 styleTable: #(
		(default 											black)
		(invalid 											red)
		(excessCode 									red)
		(comment 										(green		muchDarker)	bold)
		(unfinishedComment 							(red			muchDarker)	italic)
		(#'$'												(red			muchDarker))
		(character										(red			muchDarker)	bold)
		(integer											(red			muchDarker)	bold)
		(number											(red			muchDarker)	bold)	
		(#-													(red			muchDarker)	bold)
		(symbol											(blue			muchDarker)	bold		'BitstreamVeraSans')	
		(stringSymbol									(blue			muchDarker)	bold)	
		(literalArray										(blue			muchDarker)	bold)
		(string											(magenta	muchDarker)	bold		'BitstreamVeraSans')
		(unfinishedString								red								normal	'BitstreamVeraSans')
		(assignment										nil									bold		'Accuny')
		(ansiAssignment 								nil									bold)
		(literal											nil									italic)
		(keyword											(orange		muchDarker))
		(binary 											(orange		muchDarker)	bold)
		(unary											(orange		muchDarker))
		(incompleteKeyword							(gray			muchDarker)	underlined)
		(incompleteBinary 							(gray			muchDarker)	underlined)	
		(incompleteUnary								(gray			muchDarker)	underlined)
		(undefinedKeyword							red)
		(undefinedBinary 								red)	
		(undefinedUnary								red)													
		(patternKeyword 								nil									bold)
		(patternBinary 									nil									bold)
		(patternUnary									nil									bold)	
		(#self 											(red			muchDarker)	bold)
		(#super											(red			muchDarker)	bold) 	
		(#true 											(red			muchDarker)	bold)
		(#false 											(red			muchDarker)	bold)
		(#nil 												(red			muchDarker)	bold)
		(#thisContext 									(red			muchDarker)	bold)
		(#return											(red			muchDarker)	bold)
		(patternArg 									(blue			muchDarker)	italic)	
		(methodArg 									(blue			muchDarker)	italic)
		(blockPatternArg 								(cyan			muchDarker)	italic)
		(blockArg 										(cyan			muchDarker)	italic)
		(argument 										(blue			muchDarker)	italic)
		(blockArgColon									black) 
		(leftParenthesis								black) 
		(rightParenthesis								black) 
		(leftParenthesis1								(green		muchDarker)) 
		(rightParenthesis1							(green		muchDarker)) 
		(leftParenthesis2								(magenta	muchDarker)) 
		(rightParenthesis2							(magenta	muchDarker)) 
		(leftParenthesis3								(red			muchDarker)) 
		(rightParenthesis3							(red			muchDarker)) 
		(leftParenthesis4								(green 		darker)) 
		(rightParenthesis4							(green 		darker)) 
		(leftParenthesis5								(orange		darker)) 
		(rightParenthesis5							(orange		darker)) 
		(leftParenthesis6								(magenta	darker)) 
		(rightParenthesis6							(magenta	darker)) 
		(leftParenthesis7								blue) 
		(rightParenthesis7							blue) 
		(blockStart 										black) 
		(blockEnd 										black) 
		(blockStart1									(green		muchDarker)) 
		(blockEnd1										(green		muchDarker)) 
		(blockStart2									(magenta	muchDarker)) 
		(blockEnd2										(magenta	muchDarker)) 
		(blockStart3									(red			muchDarker)) 
		(blockEnd3										(red			muchDarker)) 
		(blockStart4									(green 		darker)) 
		(blockEnd4										(green 		darker)) 
		(blockStart5									(orange		darker)) 
		(blockEnd5										(orange		darker)) 
		(blockStart6									(magenta	darker)) 
		(blockEnd6										(magenta	darker)) 
		(blockStart7									blue) 
		(blockEnd7										blue) 																																																		
		(arrayStart										black) 
		(arrayEnd										black) 
		(arrayStart1									black) 
		(arrayEnd1										black) 
		(leftBrace		 								black) 
		(rightBrace 										black) 
		(cascadeSeparator 							black) 
		(statementSeparator 							black) 
		(externalCallType 								black) 
		(externalCallTypePointerIndicator 		black) 
		(primitiveOrExternalCallStart 				black) 
		(primitiveOrExternalCallEnd				black)
		(methodTempBar								gray) 
		(blockTempBar 									gray)
		(blockArgsBar									gray)
		(primitive										(green 		muchDarker)	bold)
		(externalFunctionCallingConvention		(green		muchDarker)	bold) 
		(module											(green		muchDarker)	bold)
		(blockTempVar 									gray								italic)
		(blockPatternTempVar						gray								italic)
		(instVar 											black								bold)
		(workspaceVar									black								bold)
		(undefinedIdentifier							red			bold)
		(incompleteIdentifier							(gray			darker)			(italic underlined))
		(tempVar										(gray			darker)			italic)
		(patternTempVar								(gray			darker)			italic)
		(poolConstant									(gray			darker)			italic)
		(classVar											(gray			darker)			bold)
		(globalVar										(magenta	darker)			bold)
).
! !

!SmallLandDevelopment methodsFor: 'applying' stamp: 'dgd 11/25/2005 14:16'!
layoutWorld
	"
	SmallLandDevelopment new layoutWorld.
	"

	(SystemWindow
		windowsIn: World
		satisfying: [:each | each label = 'Useful code snippets'])
		do: [:each |
			each height: 250.
			each width: 560.
			each bottomRight: 1024@768.
		].

	(SystemWindow
		windowsIn: World
		satisfying: [:each | each label = 'Transcript'])
		do: [:each |
			each height: 250.
			each width: 1024 - 560.
			each bottomLeft: 0@768.
		].
! !

!SmallLandDevelopment methodsFor: 'installing' stamp: 'dgd 9/21/2005 13:13'!
installPackages
	| sm |

	sm := SMSqueakMap default.
	
	self log: 'Loading SqueakMap catalog...'.
	sm loadFull.
	self log: 'SqueakMap catalog loaded!!'.

	self packagesToInstall
		do: [:pair | 
			| name version | 

			name := pair first.
			version := pair second.

			((sm packageWithNameBeginning: name) releaseWithVersion: version) isInstalled
				ifTrue:[
					self log: 'Package ''' , name asString , ''' (version: ' , version asString , ') already installed!!'.
				]
				ifFalse:[
					self log: 'Installing package ''' , name asString , ''' (version: ' , version asString , ')'.
					sm installPackageNamed: name version: version.
					self log: 'Package ''' , name asString , ''' (version: ' , version asString , ') installed!!'
				].
		].
! !

!SmallLandDevelopment methodsFor: 'installing' stamp: 'dgd 9/22/2005 11:54'!
packagesToInstall
	"private - answer a list of packages to install in the format packageName-version"

	^	#(
			"Shout"
			('Shout'							'4')
			('ShoutMonticello'				'2')
			('ShoutWorkspace'				'2')
			"xTreme tools"
			('Refactoring Browser for 3.8'	'3.8.42')
			('SUnit'							'3.1.22')
			"Seaside"
			('DynamicBindings'				'1.2')
			('KomServices'					'1.1.1')
			('KomHttpServer'					'7.0.2')
			('Seaside'							'2.5')
		).
! !

!SmallLandDevelopment methodsFor: 'private' stamp: 'dgd 11/25/2005 14:06'!
deleteAllWindows

	(SystemWindow
		windowsIn: World
		satisfying: [:each | true])
		do: [:each | 
			each model: nil.
			each delete].
! !

!SmallLandDevelopment methodsFor: 'private' stamp: 'dgd 11/25/2005 13:57'!
deleteProjectNamed: aString 
	| project |

	self log: ('deleting project named "{1}"...' translated format: {aString}).

	project := Project named: aString.
	project isNil ifFalse: [
		project removeChangeSetIfPossible.
		ProjectHistory forget: project.
		Project deletingProject: project.
	].

	(SystemWindow
		windowsIn: World
		satisfying: [:each | each label = aString])
		do: [:each | 
			each model: nil.
			each delete.
	].

	ChangeSorter removeChangeSetsNamedSuchThat: [:csName | csName = aString].
! !

!SmallLandDevelopment methodsFor: 'private' stamp: 'dgd 11/25/2005 14:08'!
deleteWindowLabeled: eachLabel 

	(SystemWindow
		windowsIn: World
		satisfying: [:each | each label = eachLabel])
		do: [:each | 
			each model: nil.
			each delete].
! !

!SmallLandDevelopment methodsFor: 'private' stamp: 'dgd 9/21/2005 10:51'!
log: anObject
	Transcript show: '- ', anObject asString; cr.! !


!SmallLandDevelopment reorganize!
('applying' apply applyColors applyFonts applyPreferences cleanWorld configurePackages configureShoutColors layoutWorld)
('installing' installPackages packagesToInstall)
('private' deleteAllWindows deleteProjectNamed: deleteWindowLabeled: log:)
!


!SMSqueakMap reorganize!
('queries' accountForEmail: accountForName: accountForUsername: accountsByInitials accountsByName accountWithId: accountWithName: categoryWithId: categoryWithNameBeginning: objectWithId: object: packageReleaseWithId: packagesByName packageWithId: packageWithNameBeginning: packageWithName: packageWithPI: topCategories)
('public-master' addCategory: addCategory:inObject: addObject: changeCategoriesTo:inObject: moveCategory:toAfter:inParent: moveCategory:toParent: newAccount:username:email: removeCategory: removeCategory:inObject: removeObject: removeRepository:)
('private' checkVersion: clearCaches clearCachesFor: clearUsernames copyFrom: countInstall deleteCategory: deleteObject: emailOccupied: findOrCreatePublisher:password:package: isLogFileAvailable lastTransactionInLog loadFullFrom: loadUpdatesFrom: loadUpdatesFull: mandatoryCategoriesFor: newAccount newObject: newPackage oldLoadFullFrom: packageCacheDirectoryName pingServer: storeOn: synchWithDisk synchWithLog updatesSinceFirstTransaction updatesSinceTransactionInLog: updatesSinceTransaction: usernameOccupied: verifyAdminPassword:)
('*SmallLand-Development-public-installation' installPackageNamed:version:)
('public-installation' clearInstalledPackages clearInstalledPackageWithId: installedPackageReleases installedPackages installedPackagesDictionary installedPackagesDictionary: installedReleaseOf: installedVersionOfPackageWithId: installedVersionOf: installPackageLatestPublishedNamed: installPackageLatestPublished: installPackageNamed: installPackageNamed:autoVersion: installPackageReleaseWithId: installPackageRelease: installPackageWithId: installPackageWithId:autoVersion: installPackage: installPackage:autoVersion: noteInstalledPackageNamed:autoVersion: noteInstalledPackageWithId:autoVersion: noteInstalledPackageWithId:autoVersion:name: noteInstalledPackage:autoVersion: noteInstalled: silentlyDo: upgradeOldPackages upgradeOldPackagesConfirmBlock: upgradeOrInstallPackageWithId: upgradeOrInstallPackage: upgradePackageWithId: upgradePackage:)
('private-installation' markInstalled:version:time:counter: noteInstalledPackageWithId:autoVersion:atSeconds:number: noteInstalledPackage:version: noteInstalledPackage:version:atSeconds:number: noteUninstalledPackageWithId:autoVersion:name: noteUninstalled:)
('accessing' accounts adminPassword: cache categories checkpointNumber daysBacklog daysBacklog: directory firstTransactionNumber objects packageCacheDirectory packages silent transactionCounter transactionCounter: users)
('checkpoints' compressFile: createCheckpoint createCheckpointNumber: extension filename getLastCheckpointWithFilename isCheckpointAvailable lastCheckpointFilename lastCheckpointNumberOnDisk nextFileNameForCheckPoint saveCheckpoint:)
('public-packages' allPackages availablePackages installableAndNotInstalledPackages installablePackages notInstalledPackages oldPackages upgradeableAndOldOrInstallableAndNotInstalledPackages upgradeableAndOldPackages upgradeablePackages)
('views' viewFor:)
('transactions' addDirty: isDirty mutex setDirty transaction:)
('public' loadFull loadUpdates purge reload)
('initialize-release' initializeOn:)
('deprecated log messages' deleteCardWithId: deleteObjectWithId: firstTransactionNumber: moveCategoryWithId:toAfterWithId: moveCategoryWithId:toParentWithId: newAccountWithId: newCardWithId: newCategoryWithId: newCategoryWithId:inCardWithId: newCategoryWithId:inObjectWithId: newPackageReleaseWithId:inPackageWithId: newPackageWithId: newRepositoryWithId:)
('logging' createNewLog createNewLogWithInitialContent: loadDateFrom: loadLog loadUpdatesFromLog loadUpdatesFrom:log: logDelete: logFileName logFirstTransactionNumberOn: logIncrementedTransactionCounterOn: logTransactionCounterOn: logUpdate:original: log: openLogFile openLogFileReadOnly)
('deprecated' addCard: addCategory:inCard: cards cardsByName cardWithId: cardWithNameBeginning: cardWithName: changeCategoriesTo:inCard: created:updated:name:summary:url:modulePath:registrator:password: deleteCategoryWithId: mapInitialsFromMinnow migrate reloadLog saveNewLog)
!

"Postscript:"

SmallLandDevelopment new apply.
!