[squeak-dev] The Trunk: System-dtl.171.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Nov 23 20:24:07 UTC 2009


David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.171.mcz

==================== Summary ====================

Name: System-dtl.171
Author: dtl
Time: 23 November 2009, 4:18:17 am
UUID: 740279b2-360a-48f7-9795-a69791253180
Ancestors: System-dtl.170

Factor Project>>findProjectView: into subclasses.
Implement #interruptName: and #interruptName:preemptedProcess: on instance side, and use Project current idiom to access them. Eliminate some related #isMorphic testing in other methods. 


=============== Diff against System-dtl.170 ===============

Item was changed:
  ----- Method: Project class>>jumpToProject (in category 'utilities') -----
  jumpToProject
  	"Project jumpToProject"
  	"Present a list of potential projects and enter the one selected."
+ 
+ 	self subclassResponsibility!
- 	| menu |
- menu:=MenuMorph new.
- menu defaultTarget: self.
- 	menu := self buildJumpToMenu: menu.
- 	menu popUpInWorld!

Item was changed:
  ----- Method: Project>>findProjectView: (in category 'accessing') -----
  findProjectView: projectDescription
+ 	"In this world, find the morph that holds onto the project described by projectDescription.
+ 	projectDescription can be a project, or the name of a project.  The project may be
+ 	represented by a DiskProxy.  The holder morph may be at any depth in the world.
+ 	Need to fix this if Projects have subclasses, or if a class other than ProjectViewMorph
+ 	can officially hold onto a project.  (Buttons, links, etc)
- 	| pName dpName proj |
- 	"In this world, find the morph that holds onto the project described by projectDescription.  projectDescription can be a project, or the name of a project.  The project may be represented by a DiskProxy.  The holder morph may be at any depth in the world.
- 	Need to fix this if Projects have subclasses, or if a class other than ProjectViewMorph can officially hold onto a project.  (Buttons, links, etc)
  	If parent is an MVC world, return the ProjectController."
  
  	self flag: #bob.		"read the comment"
+ 	self subclassResponsibility!
- 
- 
- 	pName := (projectDescription isString) 
- 		ifTrue: [projectDescription]
- 		ifFalse: [projectDescription name].
- 	self isMorphic 
- 		ifTrue: [world allMorphsDo: [:pvm |
- 				pvm class == ProjectViewMorph ifTrue: [
- 					(pvm project class == Project and: 
- 						[pvm project name = pName]) ifTrue: [^ pvm].
- 
- 					pvm project class == DiskProxy ifTrue: [ 
- 						dpName := pvm project constructorArgs first.
- 						dpName := (dpName findTokens: '/') last.
- 						dpName := (Project parseProjectFileName: dpName unescapePercents) first.
- 						dpName = pName ifTrue: [^ pvm]]]]]
- 		ifFalse: [world scheduledControllers do: [:cont |
- 				(cont isKindOf: ProjectController) ifTrue: [
- 					((proj := cont model) class == Project and: 
- 						[proj name = pName]) ifTrue: [^ cont view].
- 
- 					proj class == DiskProxy ifTrue: [ 
- 						dpName := proj constructorArgs first.
- 						dpName := (dpName findTokens: '/') last.
- 						dpName := (Project parseProjectFileName: dpName unescapePercents) first.
- 						dpName = pName ifTrue: [^ cont view]]]]
- 			].
- 	^ nil!

Item was changed:
  ----- Method: Project class>>maybeForkInterrupt (in category 'utilities') -----
  maybeForkInterrupt
  
+ 	self flag: #toRemove. "unreferenced in image, check eToys"
  	Preferences cmdDotEnabled ifFalse: [^self].
+ 	[self current interruptName: 'User Interrupt'] fork
+ !
- 	Smalltalk isMorphic
- 		ifTrue: [[self interruptName: 'User Interrupt'] fork]
- 		ifFalse: [[ScheduledControllers interruptName: 'User Interrupt'] fork]!

Item was added:
+ ----- Method: Project>>interruptName:preemptedProcess: (in category 'scheduling') -----
+ interruptName: labelString preemptedProcess: theInterruptedProcess
+ 	"Create a Notifier on the active scheduling process with the given label."
+ 
+ 	^ self subclassResponsibility
+ !

Item was changed:
  ----- Method: SystemDictionary>>handleUserInterrupt (in category 'miscellaneous') -----
  handleUserInterrupt
  	Preferences cmdDotEnabled ifTrue:
+ 		[[Project current interruptName: 'User Interrupt'] fork]
+ !
- 		[Smalltalk isMorphic
- 			ifTrue: [[Project interruptName: 'User Interrupt'] fork]
- 			ifFalse: [[ScheduledControllers interruptName: 'User Interrupt'] fork]]!

Item was added:
+ ----- Method: Project>>interruptName: (in category 'scheduling') -----
+ interruptName: labelString
+ 	"Create a Notifier on the active scheduling process with the given label."
+ 
+ 	^ self interruptName: labelString preemptedProcess: nil
+ !

Item was changed:
  ----- Method: Project class>>interruptName: (in category 'utilities') -----
  interruptName: labelString
  	"Create a Notifier on the active scheduling process with the given label."
  
+ 	self flag: #toRemove. "after restarting the user interrupt watcher process"
+ 	^ self current interruptName: labelString preemptedProcess: nil
- 	^ self interruptName: labelString preemptedProcess: nil
  !

Item was changed:
  ----- Method: SystemDictionary>>lowSpaceWatcher (in category 'memory space') -----
  lowSpaceWatcher
  	"Wait until the low space semaphore is signalled, then take appropriate actions."
  
  	| free preemptedProcess |
  	self garbageCollectMost <= self lowSpaceThreshold
  		ifTrue: [self garbageCollect <= self lowSpaceThreshold
  				ifTrue: ["free space must be above threshold before
  					starting low space watcher"
  					^ Beeper beep]].
  
  	Smalltalk specialObjectsArray at: 23 put: nil.  "process causing low space will be saved here"
  	LowSpaceSemaphore := Semaphore new.
  	self primLowSpaceSemaphore: LowSpaceSemaphore.
  	self primSignalAtBytesLeft: self lowSpaceThreshold.  "enable low space interrupts"
  
  	LowSpaceSemaphore wait.  "wait for a low space condition..."
  
  	self primSignalAtBytesLeft: 0.  "disable low space interrupts"
  	self primLowSpaceSemaphore: nil.
  	LowSpaceProcess := nil.
  
  	"The process that was active at the time of the low space interrupt."
  	preemptedProcess := Smalltalk specialObjectsArray at: 23.
  	Smalltalk specialObjectsArray at: 23 put: nil.
  
  	"Note: user now unprotected until the low space watcher is re-installed"
  
  	self memoryHogs isEmpty
  		ifFalse: [free := self bytesLeft.
  			self memoryHogs
  				do: [ :hog | hog freeSomeSpace ].
  			self bytesLeft > free
  				ifTrue: [ ^ self installLowSpaceWatcher ]].
+ 	Project current
+ 			interruptName: 'Space is low'
+ 			preemptedProcess: preemptedProcess
- 	self isMorphic
- 		ifTrue: [CurrentProjectRefactoring
- 				currentInterruptName: 'Space is low'
- 				preemptedProcess: preemptedProcess]
- 		ifFalse: [ScheduledControllers
- 				interruptName: 'Space is low'
- 				preemptedProcess: preemptedProcess]
  !

Item was removed:
- ----- Method: Project class>>interruptName:preemptedProcess: (in category 'utilities') -----
- interruptName: labelString preemptedProcess: theInterruptedProcess
- 	"Create a Notifier on the active scheduling process with the given label."
- 	| preemptedProcess projectProcess |
- 	Smalltalk isMorphic ifFalse:
- 		[^ ScheduledControllers interruptName: labelString].
- 	ActiveHand ifNotNil:[ActiveHand interrupted].
- 	ActiveWorld := World. "reinstall active globals"
- 	ActiveHand := World primaryHand.
- 	ActiveHand interrupted. "make sure this one's interrupted too"
- 	ActiveEvent := nil.
- 
- 	projectProcess := self uiProcess.	"we still need the accessor for a while"
- 	preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess].
- 	"Only debug preempted process if its priority is >= projectProcess' priority"
- 	preemptedProcess priority < projectProcess priority 
- 		ifTrue:[preemptedProcess := projectProcess].
- 	preemptedProcess suspend.
- 	Debugger openInterrupt: labelString onProcess: preemptedProcess
- !




More information about the Squeak-dev mailing list