'From Squeak3.1alpha [latest update: #''Squeak3.1alpha'' of 28 February 2001 update 3891] on 2 April 2001 at 7:42:59 pm'! "Change Set: versionUpdate Date: 2 April 2001 Author: Michael Rueger This change set introduces the class SystemVersion replacing the EToySystem handling of version information. Access to the current version information is now delegated to SystemVersion current, which also keeps track of loaded updates and the highest update number without relying on change sets. A mechanism to check for possible updates when running in a browser (the embed tag has to include an update parameter) has been added to AutoStart. "! Object subclass: #SystemVersion instanceVariableNames: 'version date highestUpdate updates ' classVariableNames: 'Current ' poolDictionaries: '' category: 'System-Support'! SystemVersion class instanceVariableNames: ''! !AbstractLauncher class methodsFor: 'activation'! deactivate "Unregister this launcher with the auto start class" self autoStarter removeLauncher: self! ! !AutoStart class methodsFor: 'class initialization'! startUp | startupParameters launchers | self checkForUpdates ifTrue: [^self]. startupParameters _ AbstractLauncher extractParameters. launchers _ self installedLaunchers collect: [:launcher | launcher new]. launchers do: [:launcher | launcher parameters: startupParameters]. launchers do: [:launcher | Smalltalk at: #WorldState ifPresent: [ :ws | ws addDeferredUIMessage: [launcher startUp]]]! ! !AutoStart class methodsFor: 'accessing'! addLauncherFirst: launcher self installedLaunchers addFirst: launcher! ! !AutoStart class methodsFor: 'updating' stamp: 'mir 3/29/2001 17:48'! checkForUpdates | availableUpdate | World ifNotNil: [World install]. HTTPClient determineIfRunningInBrowser. HTTPClient isRunningInBrowser ifFalse: [^false]. availableUpdate _ (AbstractLauncher extractParameters at: 'UPDATE' ifAbsent: [''] ) asInteger. availableUpdate ifNil: [^false]. ^SystemVersion checkAndApplyUpdates: availableUpdate! ! !Celeste class methodsFor: 'class initialization'! versionString "Answer a short string describing this version of Celeste." | highestChangeSet versionAddendum | "the changeset number should probably be removed whenever Celeste settles down" highestChangeSet _ SystemVersion current highestUpdate. versionAddendum _ highestChangeSet ifNil: ['.x'] ifNotNil: ['.' , highestChangeSet name initialIntegerOrNil printString]. ^ 'Celeste 2.0' , versionAddendum! ! !ServerDirectory methodsFor: 'updates' stamp: 'mir 4/2/2001 18:11'! putUpdate: fileStrm "Put this file out as an Update on the servers of my group. Each version of the system has its own set of update files. 'updates.list' holds the master list. Each update is a fileIn whose name begins with a number. See Utilities class readServerUpdatesThrough:saveLocally:updateImage:." | myServers updateStrm sequence newName myName response local restOfText seq fileContents | " (ScheduledControllers scheduledControllers detect: [:each | each model == Transcript] ifNone: [nil]) ifNil: [ ^ self inform: 'Please open a Transcript window, and then start putting out this update again.']. " local _ fileStrm localName. fileStrm size = 0 ifTrue: [^ self inform: 'That file has zero bytes!! May have a new name.']. fileContents _ fileStrm contentsOfEntireFile. (fileContents includes: Character linefeed) ifTrue: [self notify: 'That file contains linefeeds. Proceed if you know that this is okay (e.g. the file contains raw binary data).']. fileStrm reset. (self checkNames: (Array with: local)) ifFalse: [^ nil]. "illegal characters" myName _ group ifNil: [self moniker] ifNotNil: [group key]. response _ (PopUpMenu labels: 'Install update\Cancel update' withCRs) startUpWithCaption: 'Do you really want to broadcast the file ', local, '\to every Squeak user who updates from ' withCRs, myName, '?'. response = 1 ifFalse: [^ nil]. "abort" self openGroup. (myServers _ self checkServers) size = 0 ifTrue: [self closeGroup. ^ self]. updateStrm _ myServers first getFileNamed: 'updates.list'. sequence _ Utilities lastUpdateNum: updateStrm. restOfText _ Utilities position: updateStrm "sets the postion!!!!" atVersion: SystemVersion current version. restOfText size > 0 ifTrue: [ response _ (PopUpMenu labels: 'Make update for my older version\Cancel update' withCRs) startUpWithCaption: 'This system, ', SystemVersion current version, ' is not the latest version'. response = 1 ifFalse: [self closeGroup. ^ nil]. "abort" sequence _ Utilities olderVersNum: restOfText from: updateStrm default: sequence. ]. "get last number and add 1" seq _ (sequence+1) printString. seq size = 1 ifTrue: [seq _ '00', seq]. seq size = 2 ifTrue: [seq _ '0', seq]. newName _ seq, local. "append name to updates" (updateStrm skip: -1; next) == Character cr ifFalse: [ updateStrm nextPut: Character cr]. updateStrm nextPutAll: newName; nextPut: Character cr; nextPutAll: restOfText. myServers do: [:aServer | fileStrm reset. "reopen" aServer putFile: fileStrm named: newName retry: true. updateStrm reset. aServer putFileSavingOldVersion: updateStrm named: 'updates.list'. Transcript cr; show: 'Update succeeded on server ', aServer moniker]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. "rename the file locally (may fail)" fileStrm directory rename: local toBe: newName. ! ! !ServerDirectory methodsFor: 'updates'! putUpdateMulti: list fromDirectory: updateDirectory "Put these files out as an Update on the servers of my group. List is an array of local file names without number prefixes. Each version of the system has its own set of update files. 'updates.list' holds the master list. Each update is a fileIn whose name begins with a number. See Utilities class absorbUpdatesFromServer." | myServers updateStrm lastNum myName response restOfText newNames file numStr insertion | (self checkNames: list) ifFalse: [^ nil]. myName _ group ifNil: [self moniker] ifNotNil: [group key]. response _ (PopUpMenu labels: 'Install update\Cancel update' withCRs) startUpWithCaption: 'Do you really want to broadcast ', list size printString, ' updates', '\to every Squeak user who updates from ' withCRs, myName, '?'. response = 1 ifFalse: [^ nil]. "abort" self openGroup. (myServers _ self checkServers) size = 0 ifTrue: [self closeGroup. ^ self]. updateStrm _ myServers first getFileNamed: 'updates.list'. lastNum _ Utilities lastUpdateNum: updateStrm. restOfText _ Utilities position: updateStrm "sets the postion!!!!" atVersion: SystemVersion current version. restOfText size > 0 ifTrue: [ response _ (PopUpMenu labels: 'Make update for my older version\Cancel update' withCRs) startUpWithCaption: 'This system, ', SystemVersion current version, ' is not the latest version'. response = 1 ifFalse: [self closeGroup. ^ nil "abort"]. numStr _ FillInTheBlank request: 'Please confirm or change the starting update number' initialAnswer: (lastNum+1) printString. lastNum _ numStr asNumber - 1]. newNames _ list with: (lastNum+1 to: lastNum+list size) collect: [:each :num | (num printString padded: #left to: 4 with: $0) , each]. insertion _ String streamContents: [:s | newNames do: [:n | s nextPutAll: n; cr]]. "append name to updates" (updateStrm skip: -1; next) = Character cr ifFalse: [ updateStrm nextPut: Character cr]. updateStrm nextPutAll: insertion; nextPutAll: restOfText. myServers do: [:aServer | list doWithIndex: [:local :ind | file _ updateDirectory oldFileNamed: local. aServer putFile: file named: (newNames at: ind) retry: true. file close]. updateStrm reset. aServer putFileSavingOldVersion: updateStrm named: 'updates.list'. Transcript cr; show: 'Updates succeeded on server ', aServer moniker]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. "rename the file locally" list with: newNames do: [:local :newName | updateDirectory rename: local toBe: newName]. ! ! !ServerDirectory methodsFor: 'updates'! updateInstallVersion: newVersion "For each server group, ask whether we want to put the new version marker (#Squeak2.3) at the end of the file. Current version of Squeak must be the old one when this is done. ServerDirectory new updateInstallVersion: 'Squeak2.3' " | myServers updateStrm names choice | [names _ ServerDirectory groupNames asSortedArray. choice _ (SelectionMenu labelList: names selections: names) startUp. choice == nil] whileFalse: [ myServers _ (ServerDirectory groupNamed: choice) checkServers. myServers size = 0 ifTrue: [self inform: 'checkServers failed on one of those']. updateStrm _ myServers first getFileNamed: 'updates.list'. Utilities position: updateStrm "checks for current OLD version" atVersion: SystemVersion current version. "append name to updates" updateStrm setToEnd. (updateStrm skip: -1; next) == Character cr ifFalse: [ updateStrm nextPut: Character cr]. updateStrm nextPutAll: '#', newVersion; nextPut: Character cr. myServers do: [:aServer | updateStrm reset. aServer putFileSavingOldVersion: updateStrm named: 'updates.list'. Transcript cr; show: 'Update.list written on server ', aServer moniker]. ]! ! !StandardScriptingSystem methodsFor: 'utilities'! prepareForExternalReleaseNamed: aReleaseName "ScriptingSystem prepareForExternalReleaseNamed: '2.2Beta'" EToySystem stripMethodsForExternalRelease. ScriptingSystem saveFormsToFileNamed: aReleaseName, '.Dis.Forms'. ScriptingSystem stripGraphicsForExternalRelease. ScriptingSystem cleanupsForRelease. ScreenController initialize. ! ! !SystemDictionary methodsFor: 'sources, change log'! lastUpdateString "Smalltalk lastUpdateString" ^'latest update: #', SystemVersion current printString! ! !SystemDictionary methodsFor: 'sources, change log'! version "Answer the version of this release." ^SystemVersion current version! ! !SystemVersion methodsFor: 'accessing'! date ^date! ! !SystemVersion methodsFor: 'accessing'! date: newDate date _ newDate! ! !SystemVersion methodsFor: 'accessing' stamp: 'mir 3/29/2001 18:03'! highestUpdate | sortedUpdates | highestUpdate ifNil: [ sortedUpdates _ self updates asSortedCollection. highestUpdate _ (sortedUpdates isEmpty ifTrue: [0] ifFalse: [sortedUpdates last])]. ^highestUpdate! ! !SystemVersion methodsFor: 'accessing'! highestUpdate: anInteger highestUpdate _ anInteger! ! !SystemVersion methodsFor: 'accessing'! includesUpdate: anUpdate ^self updates includes: anUpdate! ! !SystemVersion methodsFor: 'accessing' stamp: 'mir 3/29/2001 18:01'! registerUpdate: update self updates add: update. self resetHighestUpdate! ! !SystemVersion methodsFor: 'accessing' stamp: 'mir 3/29/2001 18:01'! resetHighestUpdate highestUpdate _ nil! ! !SystemVersion methodsFor: 'accessing'! unregisterUpdate: update self updates remove: update ifAbsent: []! ! !SystemVersion methodsFor: 'accessing'! updates ^updates! ! !SystemVersion methodsFor: 'accessing'! version ^version! ! !SystemVersion methodsFor: 'accessing'! version: newVersion version _ newVersion! ! !SystemVersion methodsFor: 'accessing'! versionString "Answer the version of this release." ^ self version printString , ' of ' , self date printString , ' update ' , self highestUpdate printString! ! !SystemVersion methodsFor: 'initialize'! initialize version _ 'No version set'. date _ Date today. updates _ Set new. ! ! !SystemVersion methodsFor: 'printing'! printOn: stream stream nextPutAll: self versionString! ! !SystemVersion class methodsFor: 'accessing'! current Current ifNil: [Current _ SystemVersion new]. ^Current! ! !SystemVersion class methodsFor: 'instance creation'! new ^super new initialize! ! !SystemVersion class methodsFor: 'instance creation' stamp: 'mir 3/29/2001 18:06'! newVersion: versionName | newVersion | newVersion _ self new version: versionName. newVersion highestUpdate: self current highestUpdate. Current _ newVersion ! ! !SystemVersion class methodsFor: 'class initialization'! setVersion "SystemVersion setVersion" | newName | newName _ FillInTheBlank request: ('Please name this system version.\The old version is:\', self current version, '\set on ', self current date) withCRs initialAnswer: self current version. newName size > 0 ifTrue: [self newVersion: newName]! ! !SystemVersion class methodsFor: 'updating' stamp: 'mir 3/29/2001 17:48'! checkAndApplyUpdates: availableUpdate "SystemVersion checkAndApplyUpdates: nil" ^(availableUpdate isNil or: [availableUpdate > SystemVersion current highestUpdate]) ifTrue: [ (self confirm: 'There are updates available. Do you want to install them now?') ifFalse: [^false]. Utilities readServerUpdatesThrough: availableUpdate saveLocally: false updateImage: true. Smalltalk snapshot: true andQuit: false. true] ifFalse: [false]! ! !Utilities class methodsFor: 'fetching updates'! extractThisVersion: list "Pull out the part of the list that applies to this version." | delims lines ii out | delims _ String with: Character cr with: Character linefeed. lines _ list findTokens: delims. ii _ lines indexOf: '#', SystemVersion current version. ii = 0 ifTrue: [^ #()]. out _ OrderedCollection new. [(ii _ ii + 1) <= lines size] whileTrue: [(lines at: ii) first == $# ifTrue: [^ out "next version"]. (lines at: ii) first == $* ifFalse: [out addLast: (lines at: ii)]]. "keep, except comments" ^ out! ! !Utilities class methodsFor: 'fetching updates' stamp: 'mir 4/2/2001 16:34'! position: updateStrm atVersion: version "Set the stream to the end of the last line of updates names for this version. Usually the end of the file. We will add a new update name. Return the contents of the rest of the file." | char foundIt where data | updateStrm reset; ascii. foundIt _ false. [char _ updateStrm next. updateStrm atEnd] whileFalse: [ (char == Character cr or: [char == Character lf]) ifTrue: [ updateStrm peek == $# ifTrue: [ foundIt ifTrue: ["Next section" where _ updateStrm position. data _ updateStrm upTo: (255 asCharacter). updateStrm position: where. ^ data]. "won't be found -- copy all the way to the end" updateStrm next. (updateStrm nextMatchAll: version) ifTrue: [ (updateStrm atEnd or: [(updateStrm peek = Character cr) | (updateStrm peek = Character lf)]) ifTrue: [ foundIt _ true ]]]]]. foundIt ifTrue: [ updateStrm setToEnd. ^ '']. self error: 'The current version does not have a section in the Updates file'. ! ! !Utilities class methodsFor: 'fetching updates' stamp: 'mir 3/29/2001 18:01'! readServer: serverList updatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage "Scan the update server(s) for unassimilated updates. If maxNumber is not nil, it represents the highest-numbered update to load. This makes it possible to update only up to a particular point. If saveLocally is true, then save local copies of the update files on disc. If updateImage is true, then absorb the updates into the current image." "Utilities readServer: Utilities serverUrls updatesThrough: 828 saveLocally: true updateImage: true" | urls failed loaded docQueue this nextDoc docQueueSema str updateName | Cursor wait showWhile: [ urls _ self newUpdatesOn: (serverList collect: [:url | url, 'updates/']) throughNumber: maxNumber. loaded _ 0. failed _ nil. "send downloaded documents throuh this queue" docQueue := SharedQueue new. "this semaphore keeps too many documents from beeing queueed up at a time" docQueueSema := Semaphore new. 5 timesRepeat: [ docQueueSema signal ]. "fork a process to download the updates" self retrieveUrls: urls ontoQueue: docQueue withWaitSema: docQueueSema. "process downloaded updates in the foreground" [ this _ docQueue next. nextDoc _ docQueue next. nextDoc = #failed ifTrue: [ failed _ this ]. (failed isNil and: [ nextDoc ~= #finished ]) ] whileTrue: [ failed ifNil: [ nextDoc reset; text. nextDoc size = 0 ifTrue: [ failed _ this ]. ]. failed ifNil: [ nextDoc peek asciiValue = 4 "pure object file" ifTrue: [failed _ this]]. "Must be fileIn, not pure object file" failed ifNil: [ "(this endsWith: '.html') ifTrue: [doc _ doc asHtml]." "HTML source code not supported here yet" updateImage ifTrue: [ updateName _ (this findTokens: '/') last. ChangeSorter newChangesFromStream: nextDoc named: updateName. SystemVersion current registerUpdate: updateName initialIntegerOrNil]. saveLocally ifTrue: [self saveUpdate: nextDoc onFile: (this findTokens: '/') last]. "if wanted" loaded _ loaded + 1]. docQueueSema signal]. ]. failed ~~ nil & (urls size - loaded > 0) ifTrue: [ str _ loaded printString ,' new update file(s) processed.'. str _ str, '\Could not load ' withCRs, (urls size - loaded) printString ,' update file(s).', '\Starting with "' withCRs, failed, '".'. self inform: str]. ^ Array with: failed with: loaded ! ! SystemDictionary removeSelector: #setVersion:! EToySystem class removeSelector: #eToyVersion:date:! EToySystem class removeSelector: #setVersion! AutoStart class removeSelector: #removeLauncherClass:! "Postscript:" SystemVersion current version: (Smalltalk at: #EToySystem) version; date: (Date readFrom: ((ReadStream on: (Smalltalk at: #EToySystem) versionDate))); highestUpdate: ChangeSorter highestNumberedChangeSet. EToySystem class removeSelector: #version. EToySystem class removeSelector: #versionDate. !