'From Pharo2.0a of ''18 April 2012'' [Latest update: #20328] on 9 October 2012 at 2:23:48 pm'! Announcement subclass: #JobStart instanceVariableNames: 'job' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Announcement subclass: #JobChange instanceVariableNames: 'job' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Object subclass: #Job instanceVariableNames: 'block currentValue min max title children isRunning parent process announcer' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Morph subclass: #JobProgressBarMorph instanceVariableNames: 'button progressBar' classVariableNames: 'BarHeight BarWidth' poolDictionaries: '' category: 'Morphic-Widgets'! Morph subclass: #JobProgressMorph instanceVariableNames: 'bar hasResult job labelMorph lastRefresh lock result' classVariableNames: 'BarHeight BarWidth' poolDictionaries: '' category: 'Morphic-Widgets'! Notification subclass: #JobNotification instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! JobNotification subclass: #JobProgress instanceVariableNames: 'progress title' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Announcement subclass: #JobEnd instanceVariableNames: 'job' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! Morph subclass: #ProgressIndicatorMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic'! TestCase subclass: #JobTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'KernelTests-Processes'! JobNotification subclass: #JobStartNotification instanceVariableNames: 'job' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Processes'! !JobStart methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:56'! job ^ job! ! !JobStart methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:56'! job: anObject job := anObject! ! !BlockClosure methodsFor: '*deprecated20' stamp: 'SeanDeNigris 8/30/2012 10:40'! silentlyValue "evaluates the receiver but avoiding progress bar notifications to show up." self deprecated: 'dont use' on: 'Jul 2012' in: '2.0'. ^ self asJob loggingProgress; run.! ! !BlockClosure methodsFor: '*Kernel-Processes' stamp: 'SeanDeNigris 8/29/2012 13:41'! asJob ^ Job block: self.! ! !UITheme methodsFor: 'defaults' stamp: 'CamilloBruni 9/1/2012 20:16'! setSystemProgressMorphDefaultParameters: aProgressMorph "Set up the given progress morph." aProgressMorph color: self settings derivedMenuColor. self settings preferRoundCorner ifTrue: [aProgressMorph useRoundedCorners]. aProgressMorph borderWidth: self settings menuBorderWidth. aProgressMorph borderColor: self settings menuBorderColor. aProgressMorph updateColor.! ! !JobStart class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:38'! on: aJob ^ self new job: aJob.! ! !ProgressBarMorph methodsFor: 'initialization' stamp: 'CamilloBruni 9/1/2012 13:23'! initialize "Initialize the receiver from the current theme." super initialize. value := 0. start := 0. end := 100. self fillStyle: (self theme progressBarFillStyleFor: self); borderStyle: (self theme progressBarBorderStyleFor: self); barFillStyle: (self theme progressBarProgressFillStyleFor: self); extent: DefaultWidth@DefaultHeight + (2 * self borderWidth).! ! !ProgressBarMorph methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 20:05'! barFillStyle "Answer the fillStyle for the bar if present or the theme menuTitleColor otherwise." ^ self valueOfProperty: #barFillStyle ifAbsent: [ self theme menuTitleColor ]! ! !String methodsFor: '*UIManager-Support' stamp: 'CamilloBruni 8/30/2012 16:17'! displayProgressAt: aPoint from: minVal to: maxVal during: workBlock "Deprecated!! - Display this string as a caption over a progress bar while workBlock is evaluated. EXAMPLE (Select next 6 lines and Do It) 'Now here''s some Real Progress' displayProgressAt: Sensor cursorPoint from: 0 to: 10 during: [:bar | 1 to: 10 do: [:x | bar value: x. (Delay forMilliseconds: 500) wait]]. HOW IT WORKS (Try this in any other language :-) Since your code (the last 2 lines in the above example) is in a block, this method gets control to display its heading before, and clean up the screen after, its execution. The key, though, is that the block is supplied with an argument, named 'bar' in the example, which will update the bar image every it is sent the message value: x, where x is in the from:to: range. " "deprecated use displayProgressFrom: minVal to: maxVal during: workBlock " ^UIManager default display: self from: minVal to: maxVal during: workBlock! ! !String methodsFor: '*UIManager-Support' stamp: 'CamilloBruni 8/30/2012 16:21'! displayProgressFrom: minVal to: maxVal during: workBlock "Display this string as a caption over a progress bar while workBlock is evaluated. EXAMPLE (Select next 6 lines and Do It) 'Now here''s some Real Progress' displayProgressFrom: 0 to: 10 during: [:bar | 1 to: 10 do: [:x | bar value: x. (Delay forMilliseconds: 500) wait]]. " ^ UIManager default displayProgress: self from: minVal to: maxVal during: workBlock! ! !SystemProgressMorph methodsFor: '*Deprecated20' stamp: 'SeanDeNigris 8/29/2012 11:57'! labelAt: aSystemProgressItemMorph put: aString "Change the label for the given progressBlock to aString." self deprecated: 'Send #label: directly to the progress item itself' on: '22 May 2012' in: 'Pharo 2.0'. aSystemProgressItemMorph label: aString.! ! !SystemProgressMorph methodsFor: 'initialization' stamp: 'CamilloBruni 9/1/2012 20:16'! initialize super initialize. lock := Semaphore forMutualExclusion. self setDefaultParameters; setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #topCenter; cellInset: 5; listCentering: #center; hResizing: #rigid; vResizing: #shrinkWrap; layoutInset: 10@6; minWidth: 150! ! !SystemProgressMorph methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 20:08'! addItemShowing: aJob lock critical: [ | item items | item := JobProgressMorph job: aJob. items := self bars size. items < 10 ifTrue: [ self addMorphBack: item. self resize ]. ^ item ].! ! !SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 09:10'! close: aSystemProgressItemMorph self bars isEmpty ifTrue: [ ^ self ]. lock critical: [ aSystemProgressItemMorph delete. self bars size = 0 ifTrue: [ self width: 0. self delete ] ]. self refresh.! ! !SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 09:11'! maxBarWidth ^ self bars inject: 0 into: [ :max :next | next minExtent x max: max ].! ! !SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 11:56'! reposition self align: self fullBounds topLeft with: Display boundingBox topLeft + (20@20). self refresh.! ! !SystemProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 09:32'! resize | newWidth | newWidth := self maxBarWidth + 50 max: self width. self width: newWidth. self refresh.! ! !SystemProgressMorph methodsFor: 'private' stamp: 'CamilloBruni 8/30/2012 19:33'! show: aJob | progressMorph | self flag: 'When we go from Exceptions to announcements, delete this and use show:from:to:during:'. progressMorph := self addItemShowing: aJob. self reposition. self openInWorld. ^ progressMorph.! ! !ProgressBarMorph class methodsFor: 'instance-creation' stamp: 'SeanDeNigris 5/14/2012 15:18'! from: startNumber to: endNumber ^ self new startAt: startNumber; endAt: endNumber.! ! !ProgressBarMorph class methodsFor: 'instance-creation' stamp: 'SeanDeNigris 5/14/2012 19:44'! initialize "ProgressBarMorph initialize" DefaultWidth := 300. DefaultHeight := 16.! ! !JobChange methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:17'! job ^ job! ! !JobChange methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:17'! job: anObject job := anObject! ! !JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'! max ^ job max! ! !JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'! min ^ job min! ! !JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'! progress ^ job progress! ! !JobChange methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:16'! title ^ job title! ! !JobChange class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:38'! on: aJob ^ self new job: aJob.! ! !LoggingSystemProgressItemMorph methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/30/2012 10:50'! current: aNumber self log: start printString,' ', end printString, ' ', aNumber printString.! ! !LoggingSystemProgressItemMorph methodsFor: 'compatibility' stamp: 'SeanDeNigris 6/21/2012 00:27'! end: aNumber end := aNumber.! ! !LoggingSystemProgressItemMorph methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/30/2012 10:50'! log: aString self traceCr: aString.! ! !LoggingSystemProgressItemMorph methodsFor: 'compatibility' stamp: 'SeanDeNigris 6/21/2012 00:27'! start: aNumber start := aNumber.! ! !LoggingSystemProgressItemMorph methodsFor: 'callbacks' stamp: 'SeanDeNigris 8/30/2012 10:51'! onChange: aJob self log: start printString,' ', end printString, ' ', aJob currentValue printString.! ! !LoggingSystemProgressItemMorph methodsFor: 'callbacks' stamp: 'SeanDeNigris 8/30/2012 10:52'! onEnd: aJob self log: aJob title, ' complete'.! ! !LoggingSystemProgressItemMorph methodsFor: 'callbacks' stamp: 'SeanDeNigris 8/30/2012 10:51'! onStart: aJob self log: aJob title.! ! !ProgressInitiationException methodsFor: 'action' stamp: 'CamilloBruni 8/30/2012 16:15'! defaultAction ^ UIManager default displayProgress: progressTitle from: minVal to: maxVal during: workBlock! ! !ProgressInitiationException methodsFor: 'action' stamp: 'SeanDeNigris 6/21/2012 00:24'! sendNotificationsTo: anObject self resume: (workBlock value: (anObject start: minVal; end: maxVal)).! ! !ProgressInitiationException methodsFor: 'initialize-release' stamp: 'RAA 5/15/2000 11:43'! display: argString at: argPoint from: argMinVal to: argMaxVal during: argWorkBlock progressTitle := argString. aPoint := argPoint. minVal := argMinVal. maxVal := argMaxVal. workBlock := argWorkBlock. ^self signal! ! !UIManager methodsFor: 'deprecated' stamp: 'CamilloBruni 8/30/2012 16:18'! displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock "Display titleString as a caption over a progress bar while workBlock is evaluated." ^ self displayProgress: titleString from: minVal to: maxVal during: workBlock! ! !UIManager methodsFor: 'display' stamp: 'CamilloBruni 8/30/2012 16:20'! displayProgress: titleString from: minVal to: maxVal during: workBlock "SystemProgressMorph show: titleString from: minVal to: during: " ^ workBlock asJob title: titleString; min: minVal; max: maxVal; run.! ! !UIManager methodsFor: 'image startup' stamp: 'SeanDeNigris 8/30/2012 11:23'! boot: bootingFromDisk during: aBlock bootingFromDisk ifTrue: [ "use non-interactive manager while processing startup list" self class default: (StartupUIManager replacing: self) ]. aBlock ensure: [ self class default: self ]. self onSnapshot: bootingFromDisk! ! !UIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:26'! activate! ! !UIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:21'! beDefault self class default: self.! ! !UIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:20'! deactivate! ! !UIManager methodsFor: 'accessing' stamp: 'CamilloBruni 2/9/2012 13:06'! headlessManager " Answer an instance of headless manager, which will be used when image runs headless and non-interactive. We put it here, so subclasses can override it. " ^ CommandLineUIManager replacing: self! ! !Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 15:53'! addChild: aJob children add: aJob. aJob parent: self.! ! !Job methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 12:55'! basicProgress: aNormalizedFloat "Set the progress: 0.0 - 1.0 without triggering an update" currentValue := (min + ((max - min) * aNormalizedFloat))! ! !Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 13:42'! block: aBlock block := aBlock.! ! !Job methodsFor: 'private' stamp: 'CamilloBruni 8/30/2012 17:37'! cleanupAfterRunning isRunning := false. process := nil. self announce: JobEnd. parent ifNotNil: [ :job | job removeChild: self ].! ! !Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 15:54'! parent: aJob parent := aJob.! ! !Job methodsFor: 'private' stamp: 'CamilloBruni 10/5/2012 17:07'! prepareForRunning isRunning := true. JobStartNotification on: self. process := Processor activeProcess. self announce: JobStart.! ! !Job methodsFor: 'private' stamp: 'SeanDeNigris 8/29/2012 15:54'! removeChild: aJob children remove: aJob.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:17'! announce: anAnnouncementClass | announcement | announcement := anAnnouncementClass on: self. SystemAnnouncer uniqueInstance announce: announcement.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 16:10'! announceChange isRunning ifFalse: [ ^ self ]. self announce: JobChange.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'! block ^ block! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 15:11'! children ^ children copy.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'! currentValue ^ currentValue! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 16:11'! currentValue: aNumber currentValue := aNumber. self announceChange.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'! max ^ max! ! !Job methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:04'! max: aNumber self migrateProgressWhileUpdatingBounds: [ max := aNumber ].! ! !Job methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:08'! migrateProgressWhileUpdatingBounds: aBlockChangingBounds "Keep the progress value consistent while we change min / max" | progress | progress := self progress. aBlockChangingBounds value. self progress: progress.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'! min ^ min! ! !Job methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 13:05'! min: aNumber self migrateProgressWhileUpdatingBounds: [ min := aNumber ]. self announceChange.! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 13:46'! title ^ title! ! !Job methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 16:11'! title: anObject title := anObject. self announceChange.! ! !Job methodsFor: 'progress' stamp: 'CamilloBruni 9/1/2012 20:30'! announcer ^ announcer ifNil: [ announcer := Announcer new ].! ! !Job methodsFor: 'progress' stamp: 'SeanDeNigris 8/30/2012 10:46'! loggingProgress | log | log := LoggingSystemProgressItemMorph new. self announcer on: JobStart send: #onStart: to: log; on: JobChange send: #onChange: to: log; on: JobEnd send: #onEnd: to: log.! ! !Job methodsFor: 'progress' stamp: 'CamilloBruni 8/31/2012 09:31'! progress ^ (currentValue - min) / (max - min)! ! !Job methodsFor: 'progress' stamp: 'CamilloBruni 9/1/2012 12:55'! progress: aNormalizedFloat "Set the progress: 0.0 - 1.0" self basicProgress: aNormalizedFloat. self announceChange.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:36'! current ^ self currentValue.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:12'! current: aNumber self currentValue: aNumber.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:37'! decrement self currentValue: self currentValue - 1.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:37'! increment self currentValue: self currentValue + 1.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:35'! label ^ self title.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:34'! label: aString self title: aString.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:36'! value ^ self currentValue.! ! !Job methodsFor: 'compatibility' stamp: 'SeanDeNigris 8/29/2012 14:33'! value: aNumber self currentValue: aNumber.! ! !Job methodsFor: 'debugging' stamp: 'CamilloBruni 8/31/2012 09:23'! debug ^ process debug! ! !Job methodsFor: 'notification-handling' stamp: 'CamilloBruni 9/1/2012 12:55'! handleJobProgress: notification notification title ifNotNil: [ title := notification title ]. notification progress ifNotNil: [ self basicProgress: notification progress ]. self announceChange.! ! !Job methodsFor: 'notification-handling' stamp: 'CamilloBruni 9/1/2012 12:52'! handleJobStart: aJobStartNotification self addChild: aJobStartNotification job.! ! !Job methodsFor: 'initialize-release' stamp: 'CamilloBruni 8/31/2012 09:32'! initialize super initialize. min := 0. max := 100. currentValue := 0. title := ''. isRunning := false. children := OrderedCollection new.! ! !Job methodsFor: 'testing' stamp: 'CamilloBruni 8/31/2012 09:22'! isRunning ^ isRunning! ! !Job methodsFor: 'running' stamp: 'CamilloBruni 10/9/2012 14:22'! run | result | [ self prepareForRunning. [ result := block cull: self ] on: JobNotification do: [ :notification | notification handle: self ]] ensure: [ self cleanupAfterRunning ]. ^ result.! ! !UIManager class methodsFor: 'initialization' stamp: 'SeanDeNigris 8/30/2012 11:25'! default: aUIManager Default deactivate. Default := aUIManager. Default activate.! ! !CommandLineUIManager methodsFor: 'ui requests' stamp: 'CamilloBruni 8/30/2012 16:19'! informUserDuring: aBlock self displayProgress: '' from: 1 to: 100 during: aBlock! ! !Job class methodsFor: 'example' stamp: 'CamilloBruni 9/1/2012 20:15'! basicExample "Job basicExample" [ :job| job title: 'Simulating some progress for 1 Second'. 1 second asDelay wait. "simulate some work". job currentValue: 50. 1 second asDelay wait. "simulate some more work". job currentValue: 100. 1 second asDelay wait. "simulate some more work". ] asJob run.! ! !Job class methodsFor: 'example' stamp: 'CamilloBruni 9/1/2012 20:19'! basicExample2 "Job basicExample2" [[ :job| job max: 10. 1 to: 10 do: [ :i| job title: 'Fib ', i asString. "do some hard work" 40 benchFib. "update the job progress" job currentValue: i ] ] asJob run] fork.! ! !Job class methodsFor: 'example' stamp: 'CamilloBruni 8/30/2012 17:39'! exampleDebug "Job exampleDebug" | aJob | aJob := [ :job| "Set some job properties" job title: 'aTitle'; max: 10. 1 to: 10 do: [ :i| job title: 'Fib ', i asString. "do some hard work" 40 benchFib. "update the job progress" job currentValue: i. ] ] asJob. "run a different thread to interrupt the job" [ aJob run ] forkAt: Processor userBackgroundPriority. 1 second asDelay wait. "wait for the job to start properly" aJob debug ! ! !Job class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 13:42'! block: aBlock ^ self new block: aBlock.! ! !PharoTheme methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 20:06'! glamorousBasePassiveBackgroundColorFor: aButton ^ Color white! ! !SystemProgressMorph class methodsFor: 'initialization' stamp: 'SeanDeNigris 8/30/2012 11:27'! initialize "SystemProgressMorph initialize" self reset.! ! !SystemProgressMorph class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/30/2012 19:33'! show: aJob ^ self uniqueInstance show: aJob.! ! !SystemProgressMorph class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:03'! uniqueInstance ^ UniqueInstance ifNil: [ UniqueInstance := self new ].! ! !SystemProgressMorph class methodsFor: 'enabling/disabling' stamp: 'SeanDeNigris 8/30/2012 11:28'! disable SystemAnnouncer uniqueInstance unsubscribe: self.! ! !SystemProgressMorph class methodsFor: 'enabling/disabling' stamp: 'SeanDeNigris 8/30/2012 11:28'! enable SystemAnnouncer uniqueInstance on: JobStart send: #startJob: to: self. SystemAnnouncer uniqueInstance on: JobEnd send: #endJob: to: self. SystemAnnouncer uniqueInstance on: JobChange send: #updateJob: to: self. ! ! !SystemProgressMorph class methodsFor: 'job subscription' stamp: 'SeanDeNigris 8/29/2012 14:54'! endJob: aJobEnd self uniqueInstance close: self uniqueInstance bars last.! ! !SystemProgressMorph class methodsFor: 'job subscription' stamp: 'CamilloBruni 8/30/2012 19:47'! startJob: aJobStart self show: aJobStart job! ! !SystemProgressMorph class methodsFor: 'job subscription' stamp: 'CamilloBruni 9/1/2012 13:30'! updateJob: aJobChange self uniqueInstance bars last label: aJobChange title; progress: aJobChange progress. self uniqueInstance resize.! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'! decrement ^ progressBar decrement! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'! increment ^ progressBar increment! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 10/5/2012 17:09'! initialize super initialize. progressBar := ProgressBarMorph new. progressBar hResizing: #spaceFill. button := ThemeIcons smallErrorIcon asMorph. self color: Color transparent; layoutPolicy: TableLayout new; listDirection: #leftToRight; cellPositioning: #leftCenter; cellInset: 3; listCentering: #center; hResizing: #spaceFill; vResizing: #shrinkWrap. self addMorphBack: progressBar; addMorphBack: button.! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 9/1/2012 13:18'! progress ^ progressBar value / 100! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 9/1/2012 13:18'! progress: aNormalizedNumber ^ progressBar value: aNormalizedNumber * 100! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'! value ^ progressBar value! ! !JobProgressBarMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:04'! value: aNumber ^ progressBar value: aNumber! ! !JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/23/2012 00:25'! beComplete self close.! ! !JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:48'! current ^ bar value.! ! !JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 6/20/2012 23:24'! current: aNumber bar value: aNumber. self changed.! ! !JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:49'! decrement bar decrement.! ! !JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/14/2012 19:49'! increment bar increment.! ! !JobProgressMorph methodsFor: 'API' stamp: 'SeanDeNigris 5/22/2012 20:18'! label ^ self labelMorph contents.! ! !JobProgressMorph methodsFor: 'API' stamp: 'CamilloBruni 9/1/2012 13:29'! label: aString self label isEmpty ifTrue: [ self forceRefreshOnNextChange. self removeAllMorphs. self labelMorph contents: aString. self updateLayout ]. self width: (labelMorph fontToUse widthOfString: aString) + 25. self labelMorph contents: aString. self changed.! ! !JobProgressMorph methodsFor: 'API' stamp: 'CamilloBruni 9/1/2012 13:19'! progress ^ bar progress! ! !JobProgressMorph methodsFor: 'API' stamp: 'CamilloBruni 9/1/2012 13:19'! progress: aNormalizedNumber bar progress: aNormalizedNumber. self changed.! ! !JobProgressMorph methodsFor: '*Polymorph-Widgets' stamp: 'SeanDeNigris 5/23/2012 00:28'! changed | msRefreshRate isTimeForRefresh | msRefreshRate := 25. isTimeForRefresh := Time millisecondClockValue - lastRefresh >= msRefreshRate. super changed. (self isInWorld and: [ isTimeForRefresh ]) ifTrue: [ self refresh ].! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 01:08'! close SystemProgressMorph uniqueInstance close: self.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 00:40'! do: aBlock self changed. "We may be in the UI thread, so this will give us a change to dsiplay ourselves before the block starts" ^ [ aBlock value: self ] ensure: [ self close ].! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:24'! end: aNumber self deprecated: 'delete'. endValue := aNumber.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:24'! endAt: aNumber self deprecated: 'delete'. endValue := aNumber.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/23/2012 00:22'! forceRefreshOnNextChange lastRefresh := 0.! ! !JobProgressMorph methodsFor: 'private' stamp: 'CamilloBruni 9/1/2012 20:12'! initializeJob: aJob super initialize. lock := Semaphore forMutualExclusion. job := aJob. hasResult := false. lastRefresh := 0. self color: Color transparent; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #leftCenter; listCentering: #center; hResizing: #spaceFill; vResizing: #shrinkWrap. labelMorph := StringMorph contents: job title font: StandardFonts defaultFont. bar := JobProgressBarMorph new. bar on: #mouseUp send: #debug to: self; hResizing: #spaceFill. self updateLayout.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 12:38'! isBarStriped self flag: 'if absent?'. ^ (bar valueOfProperty: #useStripes) ifNil: [false].! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:23'! labelMorph ^ labelMorph.! ! !JobProgressMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/20/2012 19:39'! max: aNumber endValue := aNumber.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 6/21/2012 08:40'! refresh self flag: 'I don''t know what to do about the stripe... - SeanDeNigris'. " self isBarStriped ifTrue: [bar fillStyle origin: bar position - ((Time millisecondClockValue // 50 \\ 30) @ 0)]." lastRefresh := Time millisecondClockValue. self currentWorld displayWorld.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 22:47'! result ^ result.! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 22:49'! result: anObject lock critical: [ hasResult := true. result := anObject ].! ! !JobProgressMorph methodsFor: 'private' stamp: 'SeanDeNigris 5/14/2012 15:09'! start: aNumber startValue := aNumber.! ! !JobProgressMorph methodsFor: 'private' stamp: 'StephaneDucasse 5/20/2012 19:39'! startAt: aNumber startValue := aNumber.! ! !JobProgressMorph methodsFor: 'private' stamp: 'CamilloBruni 8/30/2012 18:45'! updateLayout | top | labelMorph contents isEmpty ifFalse: [ self addMorphBack: labelMorph]. self addMorphBack: bar.! ! !JobProgressMorph methodsFor: 'action' stamp: 'CamilloBruni 8/31/2012 09:21'! debug job isRunning ifTrue: [ job debug ].! ! !JobProgressMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 19:27'! job: aJob job := aJob! ! !JobProgressMorph methodsFor: '*Deprecated20' stamp: 'SeanDeNigris 6/20/2012 23:23'! value: anObject self deprecated: 'Use SystemProgressItemMorph''s "API" protocol' on: '20 June, 2012' in: 'Pharo 2.0'. (anObject isKindOf: Number) ifTrue: [ self current: anObject ]. ((anObject isKindOf: String) and: [ anObject isSymbol not ]) ifTrue: [ ^ self label: anObject ]. anObject = #label ifTrue: [ ^ self label ]. anObject = #increment ifTrue: [ ^ self increment ]. anObject = #decrement ifTrue: [ ^ self decrement ]. anObject = #setMax ifTrue: [ ^ self error: '#setMax no longer supported. File a bug report if you want it back' ]. anObject = #setMin ifTrue: [ ^ self error: '#setMin no longer supported. File a bug report if you want it back' ]. anObject = #stripe ifTrue: [ ^ self error: '#stripe no longer supported. File a bug report if you want it back' ].! ! !EllipseMorph methodsFor: 'drawing' stamp: 'CamilloBruni 8/30/2012 18:51'! drawOn: aCanvas aCanvas fillOval: bounds fillStyle: self fillStyle borderWidth: borderWidth borderColor: borderColor. ! ! !JobNotification methodsFor: 'handling' stamp: 'CamilloBruni 9/1/2012 12:48'! handle: aJob self subclassResponsibility! ! !JobProgress methodsFor: 'handling' stamp: 'CamilloBruni 9/1/2012 12:52'! handle: aJob aJob handleJobProgress: self. self resume.! ! !JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'! progress ^ progress! ! !JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'! progress: anObject progress := anObject! ! !JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'! title ^ title! ! !JobProgress methodsFor: 'accessing' stamp: 'CamilloBruni 9/1/2012 12:51'! title: anObject title := anObject! ! !JobProgress class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/1/2012 12:51'! progress: aNormalizedNumber self new progress: aNormalizedNumber; signal.! ! !JobProgress class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/1/2012 12:51'! title: aTitleString self new title: aTitleString; signal.! ! !JobProgress class methodsFor: 'instance-creation' stamp: 'CamilloBruni 9/1/2012 12:51'! title: aTitleString progress: aNormalizedNumber self new title: aTitleString; progress: aNormalizedNumber; signal.! ! !ContextPart methodsFor: 'debugging' stamp: 'CamilloBruni 8/30/2012 17:20'! debug ^ Smalltalk tools debugger openContext: self label: self printString contents: nil ! ! !MorphicUIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:26'! activate SystemProgressMorph enable.! ! !MorphicUIManager methodsFor: 'private' stamp: 'SeanDeNigris 8/30/2012 11:26'! deactivate SystemProgressMorph disable.! ! !JobEnd methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:08'! job ^ job! ! !JobEnd methodsFor: 'accessing' stamp: 'SeanDeNigris 8/29/2012 14:08'! job: anObject job := anObject! ! !Debugger methodsFor: 'accessing' stamp: 'CamilloBruni 8/30/2012 17:19'! isPostMortem "return whether we're inspecting a frozen exception without a process attached" |selectedContext suspendedContext | selectedContext := self selectedContext. suspendedContext := interruptedProcess suspendedContext. suspendedContext ifNil: [ ^ false ]. (suspendedContext == selectedContext) ifTrue: [ ^ false ]. ^ (suspendedContext findContextSuchThat: [:c | c sender == selectedContext]) isNil ! ! !JobProgressMorph class methodsFor: 'instance creation' stamp: 'CamilloBruni 8/30/2012 19:31'! job: aJob ^ self new initializeJob: aJob! ! !ProgressIndicatorMorph methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/30/2012 18:56'! drawOn: aCanvas aCanvas fillOval: self bounds fillStyle: self fillStyle borderWidth: 2 borderColor: Color black. ! ! !JobEnd class methodsFor: 'instance creation' stamp: 'SeanDeNigris 8/29/2012 14:38'! on: aJob ^ self new job: aJob.! ! !Debugger class methodsFor: 'opening' stamp: 'IgorStasenko 3/6/2011 18:39'! openContext: aContext label: aString contents: contentsStringOrNil "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger." "Simulation guard" ErrorRecursion not & self logDebuggerStackToFile ifTrue: [Smalltalk logError: aString inContext: aContext]. ErrorRecursion ifTrue:[ ErrorRecursion := false. self primitiveError: aString]. ErrorRecursion := true. self informExistingDebugger: aContext label: aString. (self context: aContext) openNotifierContents: contentsStringOrNil label: aString. ErrorRecursion := false. Processor activeProcess suspend. ! ! !JobTest methodsFor: 'tests' stamp: 'SeanDeNigris 8/29/2012 15:51'! tearDown SystemProgressMorph uniqueInstance bars do: [ :e | e close ].! ! !JobTest methodsFor: 'tests' stamp: 'CamilloBruni 8/30/2012 17:44'! testChildJob | wasRun | wasRun := false. [ :job | [ :job2 | self assert: job children size = 1. self assert: job children first = job2. wasRun := true ] asJob run. self assert: job children isEmpty ] asJob run. self assert: wasRun.! ! !JobTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2012 09:32'! testProgress | job | job := Job new. self assert: job progress equals: 0.0. job min: 0; max: 1. self assert: job progress equals: 0.0. job currentValue: 1. self assert: job progress equals: 1.0.! ! !JobTest methodsFor: 'tests' stamp: 'CamilloBruni 8/31/2012 09:32'! testProgressChangeByCurrentValue | job | job := Job new. job min: 1; max: 11. self assert: job progress equals: 0.0. job currentValue: 6. self assert: job progress equals: 0.5. job currentValue: 11. self assert: job progress equals: 1.0.! ! !JobTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2012 13:00'! testProgressNotification | wasRun | wasRun := false. [ :job | "job precondition" self assert: job title equals: ''. self assert: job progress equals: 0. JobProgress title: 'foo' progress: 0.5. self assert: job title equals: 'foo'. self assert: job progress equals: 0.5. wasRun := true ] asJob run. self assert: wasRun.! ! !JobTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2012 13:00'! testProgressNotificationChildJob | wasRun | wasRun := false. [ :job | "job precondition" self assert: job title equals: ''. self assert: job progress equals: 0. [ :job2 | "job2 precondition" self assert: job2 title equals: ''. self assert: job2 progress equals: 0. "signal a JobProgress which will only affect the inner job" JobProgress title: 'foo' progress: 0.5. self assert: job2 title equals: 'foo'. self assert: job2 progress equals: 0.5. "outer job is not touched" self assert: job title equals: ''. self assert: job progress equals: 0. wasRun := true ] asJob run. self assert: job children isEmpty ] asJob run. self assert: wasRun.! ! !JobTest methodsFor: 'tests' stamp: 'CamilloBruni 9/1/2012 12:56'! testSingleJob | wasRun | wasRun := false. [ :job | self assert: job children isEmpty. wasRun := true ] asJob run. self assert: wasRun.! ! !JobStartNotification methodsFor: 'handling' stamp: 'CamilloBruni 9/1/2012 12:52'! handle: aJob aJob handleJobStart: self. self resume.! ! !JobStartNotification methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2012 11:00'! job ^ job! ! !JobStartNotification methodsFor: 'accessing' stamp: 'CamilloBruni 8/31/2012 11:00'! job: anObject job := anObject! ! !JobStartNotification class methodsFor: 'as yet unclassified' stamp: 'CamilloBruni 8/31/2012 11:00'! on: aJob ^ (self new job: aJob) signal.! ! MorphicUIManager removeSelector: #displayProgress:at:from:to:during:! MorphicUIManager removeSelector: #displayProgress:from:to:during:! MorphicUIManager removeSelector: #progressInitiationExceptionDefaultAction:! DummyUIManager removeSelector: #displayProgress:at:from:to:during:! DummyUIManager removeSelector: #displayProgress:from:to:during:! SystemProgressMorph initialize! CommandLineUIManager removeSelector: #displayProgress:at:from:to:during:! CommandLineUIManager removeSelector: #displayProgress:from:to:during:! ProgressInitiationException removeSelector: #defaultMorphicAction! ProgressBarMorph initialize! SystemProgressItemMorph removeSelector: #value:! 'From Pharo2.0a of ''18 April 2012'' [Latest update: #20328] on 9 October 2012 at 2:49:03 pm'! !ProgressBarMorph class methodsFor: 'instance-creation' stamp: 'CamilloBruni 10/9/2012 14:48'! initialize "ProgressBarMorph initialize" DefaultWidth := 300. DefaultHeight := 10.! ! SystemProgressMorph initialize.! ProgressBarMorph initialize.! MorphicUIManager default activate.!