From VisualWorks®, 7.2 of October 20, 2003 on October 20, 2003 at 1:15:32 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] WorkCategory Smalltalk Core.Object false none id project name WebToolkit-Demos WebTaskList Project Smalltalk Core.Object false none tasks workers categories current mutex WebToolkit-Demos WebTaskList CreateNewTask Smalltalk VisualWave.HttpServlet false none WebToolkit-Demos WebTaskList Task Smalltalk Core.Object false none project name category assigned priority dueDate estimate workDone status notes inform createdBy WebToolkit-Demos WebTaskList ModifyTask Smalltalk VisualWave.HttpServlet false none WebToolkit-Demos WebTaskList Worker Smalltalk Core.Object false none id project name percentageAvailable categories WebToolkit-Demos WebTaskList FilterTasks Smalltalk VisualWave.HttpServlet false none WebToolkit-Demos WebTaskList WorkCategory As yet unclassified displayString ^name. name ^name. name: aString name := aString. printOn: aStream aStream nextPutAll: name. project ^project. project: aProject project := aProject. Project tasks addCategory: aWorkCategory categories add: aWorkCategory. aWorkCategory project: self. addTask: aTask tasks add: aTask. aTask project: self. aTask resolveWorkersIn: self. aTask resolveCategoriesIn: self. addWorker: aWorker workers add: aWorker. aWorker project: self. aWorker resolveCategoriesIn: self. categoryNamed: aString ^categories detect: [:each| each name = aString] ifNone: [nil]. taskNamed: aString ^tasks detect: [:each | each name = aString] ifNone: [nil]. tasks ^tasks. tasks: aCollection sortedBy: aDictionary | primary secondary tertiary | aDictionary isEmpty ifTrue: [^aCollection]. primary := (aDictionary at: 'primarySort' ifAbsent: [#(())]) first. primary := primary isEmpty ifTrue: [#arbitraryValue] ifFalse: [primary asSymbol]. secondary := (aDictionary at: 'secondarySort' ifAbsent: [#(())]) first. secondary := secondary isEmpty ifTrue: [#arbitraryValue] ifFalse: [secondary asSymbol]. tertiary := (aDictionary at: 'tertiarySort' ifAbsent: [#(())]) first. tertiary := tertiary isEmpty ifTrue: [#arbitraryValue] ifFalse: [tertiary asSymbol]. ^aCollection asSortedCollection: [:a :b | | ap bp as bs at bt| ap := a perform: primary. bp := b perform: primary. as := a perform: secondary. bs := b perform: secondary. at := a perform: tertiary. bt := b perform: tertiary. (ap < bp) or: [(ap = bp) & (as < bs) or: [ (ap = bp) & (as = bs) & (at <= bt)]]]. tasksFilteredBy: aDictionary | nonEmpty filtered string | aDictionary isEmpty ifTrue: [^self tasks]. nonEmpty := (Task allSortableAttributes select: [:each | (aDictionary at: each ifAbsent: [#(())]) first isEmpty not]) collect: [:each | each -> (aDictionary at: each) first]. filtered := self tasks copy. nonEmpty do: [:each | filtered := filtered select: [:eachTask | string := (eachTask perform: each key asSymbol) displayString asLowercase. ('*', each value, '*') match: string]]. ^self tasks: filtered sortedBy: aDictionary. workerNamed: aString ^workers detect: [:each| each name = aString] ifNone: [nil]. Project predefined entities alan ^Worker new name: 'Alan'; percentageAvailable: 80; categories: #('Eng'). doc ^WorkCategory new name: 'Doc'. eng ^WorkCategory new name: 'Eng'. exTask1 ^Task new category: 'Doc'; name: 'write docs'; status: 'open'; priority: 1. exTask2 ^Task new category: 'Eng'; name: 'Implement stuff'; status: 'open'; priority: 1. exTask3 ^Task new category: 'Eng'; name: 'Build examples'; status: 'open'; priority: 3. kim ^Worker new name: 'Kim'; percentageAvailable: 80; categories: #('QA'). mark ^Worker new name: 'Mark'; percentageAvailable: 80; categories: #('Doc'). nullWorker ^Worker new name: 'Nobody'; percentageAvailable: 0; categories: #(). qa ^WorkCategory new name: 'QA'. sean ^Worker new name: 'Sean'; percentageAvailable: 80; categories: #('Eng'). sherry ^Worker new name: 'Sherry'; percentageAvailable: 80; categories: #('Eng'). Project accessing categories ^categories. workers ^workers. Project initialize-release initialize tasks := OrderedCollection new. workers := OrderedCollection new. categories := OrderedCollection new. self addCategory: self eng. self addCategory: self doc. self addCategory: self qa. self addWorker: self nullWorker. setupWebWorks "self current setupWebWorks" self addWorker: self alan. self addWorker: self kim. self addWorker: self mark. self addWorker: self sean. self addWorker: self sherry. self addTask: self exTask1. self addTask: self exTask2. self addTask: self exTask3. Project garbage noChanges "Runtime packager, if there is a class called Project in the system, wants to send it #noChanges, assuming it's 3.0" ^self. Project class current current ^self mutex critical: [ current == nil ifTrue: [current := self new]. current]. mutex mutex == nil ifTrue: [mutex := Semaphore forMutualExclusion]. ^mutex. resetCurrent "Project resetCurrent" current := nil. resetMutex mutex := Semaphore forMutualExclusion. Project class instance creation new ^super new initialize. webWorks "Project resetCurrent. Project current setupWebWorks" ^self new setupWebWorks. Project class weirdly placed html helpers optionListFor: aCollection "Return select entries for all the elements in aCollection" ^self optionListFor: aCollection selecting: nil. optionListFor: aCollection selecting: something "Return select entries for all the elements in aCollection" ^self optionListFor: aCollection selectingItemsIn: (Array with: something). optionListFor: aCollection selectingItemsIn: selections "Return select entries for all the elements in aCollection" | result selectedItems | selectedItems := selections isNil ifTrue: [#()] ifFalse: [selections]. result := String new writeStream. aCollection do: [:each | result nextPutAll: '<option value="'. result nextPutAll: each displayString. result nextPutAll: '"'. ((selectedItems includes: each displayString) or: [selectedItems includes: each]) ifTrue: [ result nextPutAll: ' selected ']. result nextPutAll: '>'. result nextPutAll: each displayString. result nextPutAll: '</option>'. result cr]. ^result contents. CreateNewTask servlet stuff doPost: request response: response | task | task := Task new. task name: 'NewTask'. Project current addTask: task. response redirectTo: '../taskdetails.ssp?name=NewTask'. Task As yet unclassified arbitraryValue "A cheat for sorting. Return an arbitrary value to be sorted by, the same for every object, so it's ignored" ^42. Task accessing assigned ^assigned assigned: aWorker assigned := aWorker. assignedTo ^assigned assignedTo: aWorker self assigned: aWorker. category ^category category: aWorkCategory category := aWorkCategory createdBy ^createdBy createdBy: aWorker createdBy := aWorker dueDate ^dueDate dueDate: aDate dueDate := aDate estimate ^estimate estimate: aNumber estimate := aNumber. inform ^inform inform: aWorker inform := aWorker name ^name name: aString name := aString. notes ^notes notes: aString notes := aString. priority ^priority priority: anInteger priority := anInteger. project ^project. project: aProject project := aProject. status ^status status: aString status := aString. workDone ^workDone workDone: aNumber workDone := aNumber. Task initialize initialize name := ''. priority := 0. dueDate := Date today. estimate := 0. workDone := 1. status := 'open'. notes := ''. inform := #(). resolveCategoriesIn: aProject category := aProject categories detect: [:each | each name = category] ifNone: [nil]. resolveWorkersIn: aProject assigned := aProject workers detect: [:each | each name = assigned] ifNone: [aProject nullWorker]. Task class html helpers allAttributes ^self allFilterableAttributes, #('notes'). allFilterableAttributes ^self allSortableAttributes, #('inform'). allSortableAttributes ^#('name' 'category' 'assignedTo' 'priority' 'dueDate' 'estimate' 'workDone' 'status' 'createdBy'). emptyFilter | result | result := Dictionary new. self allFilterableAttributes do: [:each | result at: each put: #('')]. ^result. Task class instance creation new ^super new initialize. ModifyTask servlet stuff doPost: request response: response | task priority dueDate | task := Project current taskNamed: (request session contents at: 'previousName'). task name: (request getParameter: 'name'). task category: (Project current categoryNamed: (request getParameter: 'category')). task assigned: (Project current workerNamed: (request getParameter: 'assignedTo')). priority := (request getParameter: 'priority') asNumber. priority >= 0 ifTrue: [task priority: priority]. dueDate := [request session locale readDateFrom: (request getParameter: 'dueDate') readStream] on: Error do: [:ex | task dueDate]. task dueDate: dueDate. task estimate: (request getParameter: 'estimatedDays') asNumber. task workDone: (request getParameter: 'workDone') asNumber. task status: (request getParameter: 'status'). task notes: (request getParameter: 'notes'). task inform: ((request allParameterValuesAt: 'inform') collect: [:each | Project current workerNamed: each]). response redirectTo: '../wwtasks.ssp'. Worker comparing < aWorker ^self name < aWorker name. <= aWorker ^self name <= aWorker name. Worker As yet unclassified categories: aCollection categories := aCollection displayString ^name. initialize categories := OrderedCollection new. name := ''. percentageAvailable := 100. name ^name. name: aString name := aString. percentageAvailable: aSmallInteger percentageAvailable := aSmallInteger. printOn: aStream aStream nextPutAll: name. project ^project. project: aProject project := aProject. resolveCategoriesIn: aProject categories := categories collect: [:eachName | aProject categories detect: [:eachCat | eachName asString = eachCat name] ifNone: [eachName]]. Worker class instance creation new ^super new initialize. FilterTasks servlet stuff doPost: request response: response request session contents at: 'filter' put: request parameters. response redirectTo: '../wwtasks.ssp'. "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' Object Core false none Kernel-Objects Kernel-Objects HttpServlet VisualWave Core.Object false none servletConfig Web Toolkit-Servlet Servlet