Diego Gomez Deck - development tools
Last updated at 4:58 pm UTC on 14 July 2018
This is a historical page showing how to use a Squeak 3.8 image and tailor it to a particular need.
Seaside is installed which uses WAKom.
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.
!
