1: ================================================================================
  2: 
  3: Smalltalk.KSU defineClass: #WorkProcess
  4:     superclass: #{Core.Object}
  5:     indexedType: #none
  6:     private: false
  7:     instanceVariableNames: 'workName workStart workEnd workPerson workParent '
  8:     classInstanceVariableNames: ''
  9:     imports: ''
 10:     category: ''
 11: 
 12: ================================================================================
 13: 
 14: KSU.WorkProcess method for 'converting'
 15: 
 16: asRow
 17: 
 18:     | aCollection |
 19:     aCollection := OrderedCollection new: self defaultColumnSize.
 20:     aCollection add: self workName.
 21:     aCollection add: self workStart.
 22:     aCollection add: self workEnd.
 23:     aCollection add: self workPerson.
 24:     ^aCollection
 25: 
 26: ------------------------------------------------------------
 27: 
 28: KSU.WorkProcess method for 'constructing'
 29: 
 30: checkBlock
 31: 
 32:     ^self workParent ifNil: [nil] ifNotNil: [:aParent | aParent checkBlock]
 33: 
 34: ------------------------------------------------------------
 35: 
 36: KSU.WorkProcess method for 'private'
 37: 
 38: columnLabelAt: anIndex
 39: 
 40:     ^self workParent
 41:         ifNil: [nil]
 42:         ifNotNil: 
 43:             [:aParent |
 44:             aParent dataSetView
 45:                 ifNil: [nil]
 46:                 ifNotNil: [:aView | (aView columnDescriptors at: anIndex) label component label text asString]]
 47: 
 48: ------------------------------------------------------------
 49: 
 50: KSU.WorkProcess method for 'defaults'
 51: 
 52: defaultColumnSize
 53: 
 54:     ^self class defaultColumnSize
 55: 
 56: ------------------------------------------------------------
 57: 
 58: KSU.WorkProcess method for 'initialize-release'
 59: 
 60: initialize
 61: 
 62:     super initialize.
 63:     workName := nil.
 64:     workStart := nil.
 65:     workEnd := nil.
 66:     workPerson := nil.
 67:     workParent := nil.
 68:     ^self
 69: 
 70: ------------------------------------------------------------
 71: 
 72: KSU.WorkProcess method for 'printing'
 73: 
 74: printOn: aStream
 75: 
 76:     aStream nextPutAll: self class name.
 77:     aStream nextPutAll: '('.
 78:     self asRow do: 
 79:             [:each |
 80:             each isString
 81:                 ifTrue: [aStream nextPutAll: each]
 82:                 ifFalse: [each printOn: aStream]]
 83:         separatedBy: [aStream nextPutAll: ','].
 84:     aStream nextPutAll: ')'
 85: 
 86: ------------------------------------------------------------
 87: 
 88: KSU.WorkProcess method for 'accessing'
 89: 
 90: workEnd
 91: 
 92:     ^workEnd
 93: 
 94: ------------------------------------------------------------
 95: 
 96: KSU.WorkProcess method for 'accessing'
 97: 
 98: workEnd: aString
 99: 
100:     | aTable |
101:     aTable := (Dictionary new)
102:                 add: #who -> self;
103:                 add: #key -> #workEnd;
104:                 add: #previous -> workEnd;
105:                 add: #current -> aString;
106:                 add: #column -> (self columnLabelAt: 3);
107:                 yourself.
108:     self checkBlock ifNotNil: [:aBlock | (aBlock cull: aTable) ifFalse: [^nil]].
109:     workEnd := aString
110: 
111: ------------------------------------------------------------
112: 
113: KSU.WorkProcess method for 'accessing'
114: 
115: workName
116: 
117:     ^workName
118: 
119: ------------------------------------------------------------
120: 
121: KSU.WorkProcess method for 'accessing'
122: 
123: workName: aString
124: 
125:     | aTable |
126:     aTable := (Dictionary new)
127:                 add: #who -> self;
128:                 add: #key -> #workName;
129:                 add: #previous -> workName;
130:                 add: #current -> aString;
131:                 add: #column -> (self columnLabelAt: 1);
132:                 yourself.
133:     self checkBlock ifNotNil: [:aBlock | (aBlock cull: aTable) ifFalse: [^nil]].
134:     workName := aString
135: 
136: ------------------------------------------------------------
137: 
138: KSU.WorkProcess method for 'constructing'
139: 
140: workParent
141: 
142:     ^workParent
143: 
144: ------------------------------------------------------------
145: 
146: KSU.WorkProcess method for 'constructing'
147: 
148: workParent: aWorkDataSet
149: 
150:     workParent := aWorkDataSet
151: 
152: ------------------------------------------------------------
153: 
154: KSU.WorkProcess method for 'accessing'
155: 
156: workPerson
157: 
158:     ^workPerson
159: 
160: ------------------------------------------------------------
161: 
162: KSU.WorkProcess method for 'accessing'
163: 
164: workPerson: aString
165: 
166:     | aTable |
167:     aTable := (Dictionary new)
168:                 add: #who -> self;
169:                 add: #key -> #workPerson;
170:                 add: #previous -> workPerson;
171:                 add: #current -> aString;
172:                 add: #column -> (self columnLabelAt: 4);
173:                 yourself.
174:     self checkBlock ifNotNil: [:aBlock | (aBlock cull: aTable) ifFalse: [^nil]].
175:     workPerson := aString
176: 
177: ------------------------------------------------------------
178: 
179: KSU.WorkProcess method for 'accessing'
180: 
181: workStart
182: 
183:     ^workStart
184: 
185: ------------------------------------------------------------
186: 
187: KSU.WorkProcess method for 'accessing'
188: 
189: workStart: aString
190: 
191:     | aTable |
192:     aTable := (Dictionary new)
193:                 add: #who -> self;
194:                 add: #key -> #workStart;
195:                 add: #previous -> workStart;
196:                 add: #current -> aString;
197:                 add: #column -> (self columnLabelAt: 2);
198:                 yourself.
199:     self checkBlock ifNotNil: [:aBlock | (aBlock cull: aTable) ifFalse: [^nil]].
200:     workStart := aString
201: 
202: ================================================================================
203: 
204: KSU.WorkProcess class
205:     instanceVariableNames: ''
206: 
207: ================================================================================
208: 
209: KSU.WorkProcess class method for 'defaults'
210: 
211: defaultColumnSize
212: 
213:     ^4
214: 
215: ------------------------------------------------------------
216: 
217: KSU.WorkProcess class method for 'instance creation'
218: 
219: emptyRow
220: 
221:     ^self fromRow: (Array new: self defaultColumnSize withAll: String new)
222: 
223: ------------------------------------------------------------
224: 
225: KSU.WorkProcess class method for 'instance creation'
226: 
227: fromRow: aCollection
228: 
229:     ^(self new)
230:         workName: (aCollection at: 1);
231:         workStart: (aCollection at: 2);
232:         workEnd: (aCollection at: 3);
233:         workPerson: (aCollection at: 4);
234:         yourself
235: 
236: ------------------------------------------------------------
237: 
238: KSU.WorkProcess class method for 'instance creation'
239: 
240: new
241: 
242:     ^(super new)
243:         initialize;
244:         yourself
245: 
246: ================================================================================

This document was generated by KSU.TextDoclet on 2012/08/07 at 00:07:24.