The Trunk: MorphicExtras-nice.73.mcz

Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-nice.73.mcz

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

Name: MorphicExtras-nice.73
Author: nice
Time: 4 February 2010, 9:32:40.527 pm
UUID: 08959b1f-c92d-400a-9152-1c664a36c502
Ancestors: MorphicExtras-ar.72

1) merge some FreeType changes from Tween
2) move some temp declarations inside blocks
3) move some temp assignments outside blocks
4) remove some now useless fixTemps

=============== Diff against MorphicExtras-ar.72 ===============

Item was changed:
  ----- Method: ProjectSorterMorph>>clickFromSorterEvent:morph: (in category 'as yet unclassified') -----
  clickFromSorterEvent: evt morph: aMorph
 
  | where what |
  (aMorph bounds containsPoint: evt cursorPoint) ifFalse: [^self].
  evt isMouseUp ifFalse: [
  evt shiftPressed ifFalse: [^evt hand grabMorph: aMorph].
  ^self
  ].
 
  evt shiftPressed ifTrue: [
  where := aMorph owner submorphs indexOf: aMorph ifAbsent: [nil].
  what := book threadName.
  WorldState addDeferredUIMessage: [
  InternalThreadNavigationMorph openThreadNamed: what atIndex: where
+ ].
- ] fixTemps.
  (Project named: (aMorph valueOfProperty: #nameOfThisProject)) enter.
  ].
  !

Item was changed:
  ----- Method: BookMorph>>saveIndexOfOnly: (in category 'menu') -----
  saveIndexOfOnly: aPage
  "Modify the index of this book on a server.  Read the index, modify the entry for just this page, and write back.  See saveIndexOnURL. (page file names must be unique even if they live in different directories.)"
 
  | mine sf remote pageURL num pre index after dict allText allTextUrls fName strm |
  mine := self valueOfProperty: #url.
  mine ifNil: [^ self saveIndexOnURL].
+ strm := Cursor wait showWhile: [ServerFile new fullPath: mine].
- Cursor wait showWhile: [strm := (ServerFile new fullPath: mine)].
  strm ifNil: [^ self saveIndexOnURL].
  strm isString ifTrue: [^ self saveIndexOnURL].
  strm exists ifFalse: [^ self saveIndexOnURL]. "write whole thing if missing"
  strm := strm asStream.
  strm isString ifTrue: [^ self saveIndexOnURL].
  remote := strm fileInObjectAndCode.
  dict := remote first.
  allText := dict at: #allText ifAbsent: [nil]. "remote, not local"
  allTextUrls := dict at: #allTextUrls ifAbsent: [nil].
  allText size + 1 ~= remote size ifTrue: [self error: '.bo size mismatch.  Please tell Ted what you just did to this book.' translated].
 
 
  (pageURL := aPage url) ifNil: [self error: 'just had one!!' translated].
  fName := pageURL copyAfterLast: $/.
  2 to: remote size do: [:ii |
  ((remote at: ii) url findString: fName startingAt: 1
  caseSensitive: false) > 0 ifTrue: [index := ii]. "fast"
  (remote at: ii) xxxReset].
  index ifNil: ["new page, what existing page does it follow?"
  num := self pageNumberOf: aPage.
  1 to: num-1 do: [:ii | (pages at: ii) url ifNotNil: [pre := (pages at: ii) url]].
  pre ifNil: [after := remote size+1]
  ifNotNil: ["look for it on disk, put me after"
  pre := pre copyAfterLast: $/.
  2 to: remote size do: [:ii |
  ((remote at: ii) url findString: pre startingAt: 1
  caseSensitive: false) > 0 ifTrue: [after := ii+1]].
  after ifNil: [after := remote size+1]].
  remote := remote copyReplaceFrom: after to: after-1 with: #(1).
  allText ifNotNil: [
  dict at: #allText put: (allText copyReplaceFrom: after-1 to: after-2 with: #(())).
  dict at: #allTextUrls put: (allTextUrls copyReplaceFrom: after-1 to: after-2 with: #(()))].
  index := after].
 
  remote at: index put: (aPage sqkPage copyForSaving).
 
  (dict at: #modTime ifAbsent: [0]) < Time totalSeconds ifTrue:
  [dict at: #modTime put: Time totalSeconds].
  allText ifNotNil: [
  (dict at: #allText) at: index-1 put: (aPage allStringsAfter: nil).
  (dict at: #allTextUrls) at: index-1 put: pageURL].
 
  sf := ServerDirectory new fullPath: mine.
  Cursor wait showWhile: [ | remoteFile |
  remoteFile := sf fileNamed: mine.
  remoteFile fileOutClass: nil andObject: remote.
  "remoteFile close"].
  !

Item was changed:
  ----- Method: CanvasCharacterScanner>>tab (in category 'stop conditions') -----
  tab
 
+ destX := (alignment == Justified and: [self leadingTab not])
- destX _ (alignment == Justified and: [self leadingTab not])
  ifTrue: "imbedded tabs in justified text are weird"
  [destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
  ifFalse:
  [textStyle nextTabXFrom: destX
  leftMargin: leftMargin
  rightMargin: rightMargin].
+ lastIndex := lastIndex + 1.
- lastIndex _ lastIndex + 1.
  pendingKernX := 0.
  ^ false!

Item was changed:
  ----- Method: BookMorph>>insertPageColored: (in category 'insert and delete') -----
  insertPageColored: aColor
  "Insert a new page for the receiver, using the given color as its background color"
 
  | sz newPage bw bc |
  bc := currentPage isNil
  ifTrue:
  [sz := pageSize.
  bw := 0.
  Color blue muchLighter]
  ifFalse:
  [sz := currentPage extent.
  bw := currentPage borderWidth.
  currentPage borderColor].
  newPagePrototype ifNil:
  [newPage := (PasteUpMorph new)
  extent: sz;
  color: aColor.
  newPage
  borderWidth: bw;
  borderColor: bc]
+ ifNotNil: [newPage := Cursor wait showWhile: [newPagePrototype veryDeepCopy]].
- ifNotNil: [Cursor wait showWhile: [newPage := newPagePrototype veryDeepCopy]].
  newPage setNameTo: self defaultNameStemForNewPages.
  newPage vResizeToFit: false.
  pages isEmpty
  ifTrue: [pages add: (currentPage := newPage)]
  ifFalse: [pages add: newPage after: currentPage].
  self nextPage!

Item was changed:
  ----- Method: CanvasCharacterScanner>>paddedSpace (in category 'stop conditions') -----
  paddedSpace
  "Each space is a stop condition when the alignment is right justified.
  Padding must be added to the base width of the space according to
  which space in the line this space is and according to the amount of
  space that remained at the end of the line when it was composed."
 
+ destX := destX + spaceWidth + (line justifiedPadFor: spaceCount font: font).
+ lastIndex := lastIndex + 1.
- destX _ destX + spaceWidth + (line justifiedPadFor: spaceCount font: font).
- lastIndex _ lastIndex + 1.
  pendingKernX := 0.
  ^ false!

Item was changed:
  ----- Method: PaintBoxMorph>>createButtons (in category 'initialization') -----
  createButtons
  "Create buttons one at a time and let the user place them over the background.  Later can move them again by turning on AuthorModeOwner in ThreePhaseButtonMorph.
  self createButtons. "
 
- | rect button |
  #(erase: eyedropper: fill: paint: rect: ellipse: polygon: line: star: pickup: "pickup: pickup: pickup:" stamp: "stamp: stamp: stamp:" undo: keep: toss: prevStamp: nextStamp:) do: [:sel |
+ | rect button |
  (self submorphNamed: sel) ifNil:
  [self inform: 'Rectangle for ',sel.
  rect := Rectangle fromUser.
  button := ThreePhaseButtonMorph new.
  button onImage: nil; bounds: rect.
  self addMorph: button.
  button actionSelector: #tool:action:cursor:evt:; arguments: (Array with: button with: sel with: nil).
  button actWhen: #buttonUp; target: self]].
+ #(brush1: brush2: brush3: brush4: brush5: brush6: ) doWithIndex: [:sel :ind |
+ | rect button nib |
- #(brush1: brush2: brush3: brush4: brush5: brush6: ) doWithIndex: [:sel :ind | | nib |
  (self submorphNamed: sel) ifNil:
  [self inform: 'Rectangle for ',sel.
  rect := Rectangle fromUser.
  button := ThreePhaseButtonMorph new.
  button onImage: nil; bounds: rect.
  self addMorph: button.
  nib := Form dotOfSize: (#(1 2 3 6 11 26) at: ind).
  button actionSelector: #brush:action:nib:evt:;
  arguments: (Array with: button with: sel with: nib).
  button actWhen: #buttonUp; target: self]].
  "stamp:  Stamps are held in a ScrollingToolHolder.  Pickups and stamps and brushes are id-ed by the button == with item from a list."
 
 
  !

Item was changed:
  ----- Method: BookMorph>>fromURL: (in category 'initialization') -----
  fromURL: url
  "Make a book from an index and a bunch of pages on a server.  NOT showing any page!!"
 
  | strm |
+ strm := Cursor wait showWhile: [
+ (ServerFile new fullPath: url) asStream].
- Cursor wait showWhile: [
- strm := (ServerFile new fullPath: url) asStream].
  strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil].
  self setProperty: #url toValue: url.
  self fromRemoteStream: strm.
  ^ self!

Item was changed:
  ----- Method: SqueakPage>>fetchInformIfError (in category 'accessing') -----
  fetchInformIfError
  "Make every effort to get contentsMorph.  Put up a good notice if can't get it.  Assume page is in the cache already.  Overwrite the contentsMorph no matter what."
  | strm page temp temp2 |
 
  SqueakPageCache write. "sorry about the pause"
+ strm := Cursor wait showWhile: [
+ (ServerFile new fullPath: url) asStream].
- Cursor wait showWhile: [
- strm := (ServerFile new fullPath: url) asStream].
  strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil]. "<<<<< Note Diff"
  (url beginsWith: 'file:') ifTrue: [Transcript show: 'Fetching  ', url; cr].
  page := strm fileInObjectAndCode.
  page isMorph
  ifTrue: [contentsMorph := page] "may be a bare morph"
  ifFalse: ["copy over the state"
  temp := url.
  temp2 := policy.
  self copyFrom: page. "including contentsMorph"
  url := temp. "I know best!!"
  temp2 ifNotNil: [policy := temp2]]. "use mine"
  contentsMorph setProperty: #pageDirty toValue: nil.
  contentsMorph setProperty: #SqueakPage toValue: self.
  self dirty: false.
  ^ contentsMorph!

Item was changed:
  ----- Method: TextPlusMorph>>textPlusMenuFor: (in category 'as yet unclassified') -----
  textPlusMenuFor: aMorph
 
  | menu |
  menu := MenuMorph new.
  menu
  add: 'Link to text selection'
+ target: [self addAlansAnchorFor: aMorph]
- target: [self addAlansAnchorFor: aMorph] fixTemps
  selector: #value;
 
  add: 'Unlink from text selection'
+ target: [self removeAlansAnchorFor: aMorph]
- target: [self removeAlansAnchorFor: aMorph] fixTemps
  selector: #value;
 
  add: 'Delete'
  target: [
  self removeAlansAnchorFor: aMorph.
  aMorph delete.
+ ]
- ] fixTemps
  selector: #value.
  ^menu
  !

Item was changed:
  ----- Method: SqueakPage>>fetchContentsIfAbsent: (in category 'accessing') -----
  fetchContentsIfAbsent: failBlock
  "Make every effort to get contentsMorph.  Assume I am in the cache already."
  | strm page temp temp2 |
  SqueakPageCache write. "sorry about the pause"
+ strm := Cursor wait showWhile: [
+ (ServerFile new fullPath: url) asStream].
- Cursor wait showWhile: [
- strm := (ServerFile new fullPath: url) asStream].
  strm isString ifTrue: [^ failBlock value].
  page := strm fileInObjectAndCode.
  page isMorph ifTrue: [contentsMorph := page]. "may be a bare morph"
  "copy over the state"
  temp := url.
  temp2 := policy.
  self copyAddedStateFrom: page.
  url := temp. "don't care what it says"
  temp2 ifNotNil: [policy := temp2]. "use mine"
  contentsMorph setProperty: #pageDirty toValue: nil.
  self dirty: false.
  ^ contentsMorph!

Item was changed:
  ----- Method: PaintBoxMorph>>moveButtons (in category 'initialization') -----
  moveButtons
  "Move buttons one at a time and let the user place them over the background.  Later can move them again by turning on AuthorModeOwner in ThreePhaseButtonMorph.
  self createButtons. "
 
+ #(erase: eyedropper: fill: paint: rect: ellipse: polygon: line: star: "pickup: pickup: pickup: pickup:" "stamp: stamp: stamp: stamp:" undo: keep: toss: prevStamp: nextStamp:
+ brush1: brush2: brush3: brush4: brush5: brush6: ) do: [:sel |
+ | rect button |
- | rect button |
- #(erase: eyedropper: fill: paint: rect: ellipse: polygon: line: star: "pickup: pickup: pickup: pickup:" "stamp: stamp: stamp: stamp:" undo: keep: toss: prevStamp: nextStamp:) do: [:sel |
  self inform: 'Rectangle for ',sel.
  rect := Rectangle fromUser.
  button := self submorphNamed: sel.
  button bounds: rect. "image is nil"].
- #(brush1: brush2: brush3: brush4: brush5: brush6: ) doWithIndex: [:sel :ind |
- self inform: 'Rectangle for ',sel.
- rect := Rectangle fromUser.
- button := self submorphNamed: sel.
- button bounds: rect. "image is nil"].
  "stamp:  Stamps are held in a ScrollingToolHolder.  Pickups and stamps and brushes are id-ed by the button == with item from a list."
-
- "
- "
  !

Item was changed:
  ----- Method: BookMorph>>insertPageSilentlyAtEnd (in category 'insert and delete') -----
  insertPageSilentlyAtEnd
  "Create a new page at the end of the book.  Do not turn to it."
 
  | sz newPage bw bc cc |
  cc := currentPage isNil
  ifTrue:
  [sz := pageSize.
  bw := 0.
  bc := Color blue muchLighter.
  color]
  ifFalse:
  [sz := currentPage extent.
  bw := currentPage borderWidth.
  bc := currentPage borderColor.
  currentPage color].
  newPagePrototype ifNil:
  [newPage := (PasteUpMorph new)
  extent: sz;
  color: cc.
  newPage
  borderWidth: bw;
  borderColor: bc]
+ ifNotNil: [newPage := Cursor wait showWhile: [newPagePrototype veryDeepCopy]].
- ifNotNil: [Cursor wait showWhile: [newPage := newPagePrototype veryDeepCopy]].
  newPage setNameTo: self defaultNameStemForNewPages.
  newPage vResizeToFit: false.
  pages isEmpty
  ifTrue: [pages add: (currentPage := newPage) "had been none"]
  ifFalse: [pages add: newPage after: pages last].
  ^newPage!

Item was changed:
  ----- Method: InternalThreadNavigationMorph>>loadPageWithProgress (in category 'private') -----
  loadPageWithProgress
  "Load the desired page, showing a progress indicator as we go"
 
  | projectInfo projectName beSpaceHandler |
  projectInfo := listOfPages at: currentIndex.
  projectName := projectInfo first.
  loadedProject := Project named: projectName.
  self class know: listOfPages as: threadName.
  beSpaceHandler := (ActiveWorld keyboardNavigationHandler == self).
  WorldState addDeferredUIMessage:
+ [InternalThreadNavigationMorph openThreadNamed: threadName atIndex: currentIndex beKeyboardHandler: beSpaceHandler].
- [InternalThreadNavigationMorph openThreadNamed: threadName atIndex: currentIndex beKeyboardHandler: beSpaceHandler] fixTemps.
 
  loadedProject ifNil: [
  ComplexProgressIndicator new
  targetMorph: self;
  historyCategory: 'project loading' translated;
  withProgressDo: [
  [
  loadedProject := Project current
  fromMyServerLoad: projectName
  ]
  on: ProjectViewOpenNotification
  do: [ :ex | ex resume: false]
  "we probably don't want a project view morph in this case"
  ].
  ].
  loadedProject ifNil: [
  ^self inform: 'I cannot find that project' translated
  ].
  self delete.
 
  loadedProject enter.
  !

Item was changed:
  ----- Method: PaintBoxMorph>>init3 (in category 'initialization') -----
  init3
  "Just a record of how we loaded in the latest paintbox button images"
 
+ | bb pic16Bit aa blt thin |
- | bb pic16Bit aa blt rect thin |
  self loadoffImage: 'etoy_default.gif'.
  self allMorphsDo:
  [:button |
  (button isKindOf: ThreePhaseButtonMorph)
  ifTrue: [button offImage: nil]
  ifFalse: [button position: button position + (100 @ 0)]].
  (bb := self submorphNamed: #keep:) position: bb position + (100 @ 0).
  (bb := self submorphNamed: #toss:) position: bb position + (100 @ 0).
  (bb := self submorphNamed: #undo:) position: bb position + (100 @ 0).
  "Transparent is (Color r: 1.0 g: 0 b: 1.0)"
  self moveButtons.
  self loadOnImage: 'etoy_in.gif'.
  AllOnImage := nil.
  'save space'.
  self loadPressedImage: 'etoy_in.gif'.
  AllPressedImage := nil.
  'save space'.
  self loadCursors.
 
  "position the stamp buttons"
  stampHolder stampButtons owner last delete.
  stampHolder pickupButtons last delete.
  stampHolder stampButtons: (stampHolder stampButtons copyFrom: 1 to: 3).
  stampHolder pickupButtons: (stampHolder pickupButtons copyFrom: 1 to: 3).
- "| rect |"
  stampHolder pickupButtons do:
  [:button |
+ | rect |
  "PopUpMenu notify: 'Rectangle for ',sel."
 
  rect := Rectangle fromUser.
  button bounds: rect "image is nil"].
  "| rect lay |"
  stampHolder clear.
  stampHolder stampButtons do:
+ [:button |
+ | lay rect |
- [:button | | lay |
  button
  offImage: nil;
  pressedImage: nil.
  lay := button owner.
  "PopUpMenu notify: 'Rectangle for ',sel."
  rect := Rectangle fromUser.
  button image: (Form fromDisplay: (rect insetBy: 2)).
  lay borderWidth: 2.
  lay bounds: rect "image is nil"].
  "| pic16Bit blt aa on |"
  pic16Bit := GIFReadWriter formFromFileNamed: 'etoy_in.gif'. "really 8"
  aa := Form extent: OriginalBounds extent depth: 8.
  blt := BitBlt current toForm: aa.
  blt
  sourceForm: pic16Bit;
  combinationRule: Form over;
  sourceRect: OriginalBounds;
  destOrigin: 0 @ 0;
  copyBits.
  "Collect all the images for the buttons in the on state"
  stampHolder pickupButtons do:
  [:button | | on |
  on := ColorForm extent: button extent depth: 8.
  on colors: pic16Bit colors.
  on
  copy: (0 @ 0 extent: button extent)
  from: button topLeft - self topLeft
  in: aa
  rule: Form over.
  button
  image: on;
  pressedImage: on;
  offImage: nil].
  self invalidRect: bounds.
  ((self submorphNamed: #erase:) arguments third) offset: 12 @ 35.
  ((self submorphNamed: #eyedropper:) arguments third) offset: 0 @ 0.
  ((self submorphNamed: #fill:) arguments third) offset: 10 @ 44.
  ((self submorphNamed: #paint:) arguments third) offset: 3 @ 3. "unused"
  ((self submorphNamed: #rect:) arguments third) offset: 6 @ 17.
  ((self submorphNamed: #ellipse:) arguments third) offset: 5 @ 4.
  ((self submorphNamed: #polygon:) arguments third) offset: 5 @ 4.
  ((self submorphNamed: #line:) arguments third) offset: 5 @ 17.
  ((self submorphNamed: #star:) arguments third) offset: 2 @ 5.
  thumbnail delete.
  thumbnail := nil.
  (submorphs select: [:e | e class == RectangleMorph]) first
  bounds: Rectangle fromUser.
  ((submorphs select: [:e | e class == RectangleMorph]) first)
  borderWidth: 1;
  borderColor: Color black.
  "| thin |"
  submorphs do: [:ss | ss class == ImageMorph ifTrue: [thin := ss "first"]].
  colorMemoryThin := thin!