Keith Hodges uploaded a new version of Sake-BobSeaside to project Bob the Builder: http://www.squeaksource.com/Bob/Sake-BobSeaside-kph.1.mcz
==================== Summary ====================
Name: Sake-BobSeaside-kph.1 Author: kph Time: 20 July 2009, 8:06:19 pm UUID: 2cb25031-a184-4dd5-a3a6-1e84063eaa20 Ancestors:
First cut of UI
==================== Snapshot ====================
SystemOrganization addCategory: #'Sake-BobSeaside'!
WAComponent subclass: #BobComponent instanceVariableNames: 'tasks scheduler' classVariableNames: '' poolDictionaries: '' category: 'Sake-BobSeaside'!
----- Method: BobComponent class>>canBeRoot (in category 'as yet unclassified') ----- canBeRoot
^ true!
----- Method: BobComponent class>>initialize (in category 'as yet unclassified') ----- initialize self registerAsAuthenticatedApplication: 'bob'!
----- Method: BobComponent>>children (in category 'as yet unclassified') ----- children
^ Array with: scheduler with: tasks!
----- Method: BobComponent>>initialize (in category 'as yet unclassified') ----- initialize super initialize. scheduler := SakeSchedulerComponent new. tasks := BobTasksComponent new!
----- Method: BobComponent>>renderContentOn: (in category 'as yet unclassified') ----- renderContentOn: html html heading level: 1; with: 'Bob the (Squeak) Builder'.
html heading level: 2; with: 'Periodic Services'. html render: scheduler. html heading level: 2; with: 'Build Tasks'. html render: tasks!
WAComponent subclass: #BobTaskDetailComponent instanceVariableNames: 'script task' classVariableNames: '' poolDictionaries: '' category: 'Sake-BobSeaside'!
----- Method: BobTaskDetailComponent class>>script: (in category 'as yet unclassified') ----- script: aScript
^ self basicNew script: aScript; initialize; yourself!
----- Method: BobTaskDetailComponent class>>task: (in category 'as yet unclassified') ----- task: aScript
^ self basicNew task: aScript; initialize; yourself!
----- Method: BobTaskDetailComponent>>renderContentOn: (in category 'as yet unclassified') ----- renderContentOn: html | s | s := String new writeStream. task info storeOn: s. html heading level: 1; with: task name.
html heading level: 2; with: 'Build meta data'. html preformatted: s contents.
html heading level: 2; with: 'script.st'.
html preformatted: task script contents. html anchor callback: [ self answer ]; with: 'Close'.!
----- Method: BobTaskDetailComponent>>task: (in category 'as yet unclassified') ----- task: t
task :=t!
WAComponent subclass: #BobTasksComponent instanceVariableNames: 'taskList needed uploadNeeded styles' classVariableNames: '' poolDictionaries: '' category: 'Sake-BobSeaside'!
----- Method: BobTasksComponent>>buildNow: (in category 'as yet unclassified') ----- buildNow: task
[ (task class taskBuildNow: task selector) run ] fork.!
----- Method: BobTasksComponent>>buildNowStepping: (in category 'as yet unclassified') ----- buildNowStepping: task
[ ((task class taskBuildNow: task selector) stepAction: true; stepScript: true; yourself) run ] fork.!
----- Method: BobTasksComponent>>buildNowSteppingScript: (in category 'as yet unclassified') ----- buildNowSteppingScript: task
[ ((task class taskBuildNow: task selector) stepScript: true; yourself) run ] fork.!
----- Method: BobTasksComponent>>initialize (in category 'as yet unclassified') ----- initialize super initialize. needed := Dictionary new. uploadNeeded := Dictionary new. styles := IdentityDictionary new at: #unknown put: 'background-color : white ; color : lightgrey'; at: #notWanted put: 'background-color : white ; color : lightgrey'; at: #noOutput put: 'background-color : white ; color : lightgrey'; at: #dont put: 'background-color : white ; color : lightgrey'; at: #notFound put: 'background-color : white ; color : black'; at: #inProgress put: 'background-color : yellow ; color : black'; at: #interactive put: 'background-color : green ; color : white'; at: #manual put: 'background-color : green ; color : white'; at: #newStart put: 'background-color : lightgreen ; color : black'; at: #imageChanged put: 'background-color : lightgreen ; color : black'; at: #waiting put: 'background-color : grey ; color : green'; yourself. self updateStatus.!
----- Method: BobTasksComponent>>reloadTaskList (in category 'as yet unclassified') ----- reloadTaskList
taskList := BobBuild listAll!
----- Method: BobTasksComponent>>renderContentOn: (in category 'as yet unclassified') ----- renderContentOn: html
| status | html anchor on: #reloadTaskList of: self.
html break. html anchor on: #updateStatus of: self. html table: [ html tableRow: [ html tableHeading: 'Output Name'; tableHeading: 'Input'; tableHeading: 'Status'; tableHeading: 'Latest'; tableHeading: 'Release'; yourself ]. self taskList keysAndValuesDo: [ :n :aTask | status := (needed at: aTask ifAbsent: [ {false. #unknown. 'No Idea'} ]). html tableRow style: (styles at: status second ifAbsent:[ '' ]); id: aTask class name, n asString; with: [ self updateTask: aTask status: status on: html ]. ] ]!
----- Method: BobTasksComponent>>taskList (in category 'as yet unclassified') ----- taskList
taskList ifNil: [ self reloadTaskList ]. ^ taskList!
----- Method: BobTasksComponent>>updateStatus (in category 'as yet unclassified') ----- updateStatus
needed := Dictionary new.
self taskList keysAndValuesDo: [ :n :aTask | needed at: aTask put: (aTask isBuildWanted ifNil: [ aTask isBuildNeeded ]). uploadNeeded at: aTask put: (aTask asTaskUpload isNeeded). ]!
----- Method: BobTasksComponent>>updateTask:status:on: (in category 'as yet unclassified') ----- updateTask: task status: status on: html | latestInfo releaseInfo | html tableData title: task class name, '>>',task info build; with: [ html render: task name. ]. html tableData title: task info image; with: [ html render: task info image asFile fileName. ].
html tableData title: status third; with: [ html render: status second asReadableText . ].
latestInfo := task infoFileReadRelease. latestInfo build = #none ifTrue: [ latestInfo := nil ].
html tableData: [ latestInfo ifNotNil: [ html anchor title: latestInfo printString; with: (latestInfo timeStart printYYMMDDHHSS: '-') ] ]. releaseInfo := task infoFileReadRelease. releaseInfo build = #none ifTrue: [ releaseInfo := nil ].
html tableData: [ releaseInfo ifNotNil: [ html anchor title: releaseInfo printString; with: (releaseInfo timeStart printYYMMDDHHSS: '-') ] ]. " html tableData: [ html render: task info when. ]. " html tableData: [ html anchor title: 'View Script'; callback: [ WARenderLoop new call: (BobTaskDetailComponent task: task) ]; with: 'Script'. status second = #inProgress ifFalse: [ html space anchor title: 'Build Now'; callback: [ self buildNow: task ]; with: 'Build'. html space anchor title: 'Build Now, halting at each step'; callback: [ self buildNowStepping: task ]; with: 'Debug'. ]. (uploadNeeded at: task ifAbsent: false) ifTrue: [ html space anchor title: 'Upload to: ', task info upload asString; callback: [ task asTaskUpload run ]; with: 'Upload'. ] ]. !