The Trunk: System-dtl.171.mcz

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
- !