[Pkg] Bob the Builder: Sake-BobSeaside-kph.1.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Mon Jul 20 19:06:21 UTC 2009
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'.
]
].
!
More information about the Packages
mailing list