The Trunk: Tools-nice.150.mcz

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

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

Name: Tools-nice.150
Author: nice
Time: 27 December 2009, 12:52:43 pm
UUID: e42f1a02-357e-454d-8123-8de0caef753d
Ancestors: Tools-ar.149

Cosmetic: move or remove a few temps inside closures

=============== Diff against Tools-ar.149 ===============

Item was changed:
  ----- Method: ParagraphEditor>>browseItHere (in category '*Tools') -----
  browseItHere
  "Retarget the receiver's window to look at the selected class, if appropriate.  3/1/96 sw"
+ | aSymbol b |
- | aSymbol foundClass b |
  (((b := model) isKindOf: Browser) and: [b couldBrowseAnyClass])
  ifFalse: [^ view flash].
  model okToChange ifFalse: [^ view flash].
  self selectionInterval isEmpty ifTrue: [self selectWord].
+ (aSymbol := self selectedSymbol) ifNil: [^ view flash].
- (aSymbol := self selectedSymbol) isNil ifTrue: [^ view flash].
 
  self terminateAndInitializeAround:
+ [| foundClass |
+ foundClass := (Smalltalk at: aSymbol ifAbsent: [nil]).
+ foundClass ifNil: [^ view flash].
- [foundClass := (Smalltalk at: aSymbol ifAbsent: [nil]).
- foundClass isNil ifTrue: [^ view flash].
  (foundClass isKindOf: Class)
  ifTrue:
  [model systemCategoryListIndex:
  (model systemCategoryList indexOf: foundClass category).
  model classListIndex: (model classList indexOf: foundClass name)]]!

Item was changed:
  ----- Method: CodeHolder>>buildOptionalButtonsWith: (in category 'toolbuilder') -----
  buildOptionalButtonsWith: builder
 
+ | panelSpec |
- | panelSpec buttonSpec |
  panelSpec := builder pluggablePanelSpec new.
  panelSpec children: OrderedCollection new.
  self optionalButtonPairs do:[:spec|
+ | buttonSpec |
  buttonSpec := builder pluggableActionButtonSpec new.
  buttonSpec model: self.
  buttonSpec label: spec first.
  buttonSpec action: spec second.
  spec second == #methodHierarchy ifTrue:[
  buttonSpec color: #inheritanceButtonColor.
  ].
  spec size > 2 ifTrue:[buttonSpec help: spec third].
  panelSpec children add: buttonSpec.
  ].
  "What to show"
  panelSpec children add: (self buildCodeProvenanceButtonWith: builder).
 
  panelSpec layout: #horizontal. "buttons"
  ^panelSpec!

Item was changed:
  ----- Method: Debugger>>mailOutBugReport (in category 'context stack menu') -----
  mailOutBugReport
  "Compose a useful bug report showing the state of the process as well as vital image statistics as suggested by Chris Norton -
  'Squeak could pre-fill the bug form with lots of vital, but
  oft-repeated, information like what is the image version, last update
  number, VM version, platform, available RAM, author...'
 
  and address it to the list with the appropriate subject prefix."
 
- | messageStrm |
  MailSender default ifNil: [^self].
 
  Cursor write
  showWhile:
  ["Prepare the message"
+ | messageStrm |
  messageStrm := WriteStream on: (String new: 1500).
  messageStrm nextPutAll: 'From: ';
  nextPutAll: MailSender userName;
  cr;
  nextPutAll: 'To: [hidden email]';
  cr;
  nextPutAll: 'Subject: ';
  nextPutAll: '[BUG]'; nextPutAll: self interruptedContext printString;
  cr;cr;
  nextPutAll: 'here insert explanation of what you were doing, suspect changes you''ve made and so forth.';cr;cr.
  self interruptedContext errorReportOn: messageStrm.
 
  MailSender sendMessage: (MailMessage from: messageStrm contents)].
  !

Item was changed:
  ----- Method: CodeHolder class>>addContentsSymbolQuint:afterEntry: (in category 'controls') -----
  addContentsSymbolQuint: quint afterEntry: aSymbol
  "Register a menu selection item in the position after the entry with
  selection symbol aSymbol."
 
  "CodeHolder
  addContentsSymbolQuint: #(#altSyntax #toggleAltSyntax #showingAltSyntaxString 'altSyntax' 'alternative syntax')
  afterEntry: #colorPrint"
 
- | entry |
  ContentsSymbolQuints
  detect: [:e | (e isKindOf: Collection) and: [e first = quint first]]
+ ifNone: [
+ | entry |
+ entry := ContentsSymbolQuints
- ifNone: [entry := ContentsSymbolQuints
  detect: [:e | (e isKindOf: Collection) and: [e first = aSymbol]].
  ContentsSymbolQuints add: quint after: entry.
  ^ self].
  self notify: 'entry already exists for ', quint first!

Item was changed:
  ----- Method: FileChooser>>addFullPanesTo:from: (in category 'ui creation') -----
  addFullPanesTo: aMorph from: aCollection
- | frame |
  aCollection do: [ :each |
+ | frame |
  frame := LayoutFrame
  fractions: each second
  offsets: each third.
  aMorph addMorph: each first fullFrame: frame.
  ]!

Item was changed:
  ----- Method: Browser>>flattenHierarchyTree:on:indent: (in category 'class list') -----
  flattenHierarchyTree: classHierarchy on: col indent: indent
 
+ | plusIndent |
- | class childs plusIndent |
  plusIndent := String space.
  classHierarchy do: [:assoc |
+ | class childs |
  class := assoc key.
  col add: indent , class name.
  childs := assoc value.
  self
  flattenHierarchyTree: childs
  on: col
  indent: indent , plusIndent].
  ^ col!

Item was changed:
  ----- Method: CodeHolder>>offerWhatToShowMenu (in category 'what to show') -----
  offerWhatToShowMenu
  "Offer a menu governing what to show"
+ | builder menuSpec |
- | builder menuSpec item |
  builder := ToolBuilder default.
  menuSpec := builder pluggableMenuSpec new.
  self contentsSymbolQuints do: [:aQuint | aQuint == #-
  ifTrue: [menuSpec addSeparator]
  ifFalse: [
+ | item |
  item := menuSpec add: (self perform: aQuint third)
  target: self selector: aQuint second argumentList: #().
  item help: aQuint fifth.
  ].
  ].
  builder runModal: (builder open: menuSpec).!

Item was changed:
  ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchicallyIndent (in category 'tests') -----
  testListClassesHierarchicallyIndent
 
+ | result dict  |
- | result dict indent |
  result := self hierarchicalClassListForCategory: 'Tools-Browser'.
  "Create class->indent mapping"
  dict := result inject: Dictionary new into: [:classIndentMapping :className |
+ | indent |
  indent := className count: [:char | char = Character space or: [char = Character tab]].
  classIndentMapping at: (self nameToClass: className) put: indent.
  classIndentMapping].
  "assert that indent of class is larger than indent of superclass"
  dict keysAndValuesDo: [:class :myIndent |
  dict at: class superclass ifPresent: [:superIndent |
  self assert: myIndent > superIndent]].!

Item was changed:
  ----- Method: Browser>>copyClass (in category 'class functions') -----
  copyClass
+ | originalName copysName oldDefinition newDefinition |
- | originalName copysName class oldDefinition newDefinition |
  classListIndex = 0 ifTrue: [^ self].
  self okToChange ifFalse: [^ self].
  originalName := self selectedClass name.
  copysName := self request: 'Please type new class name' initialAnswer: originalName.
  copysName = '' ifTrue: [^ self].  " Cancel returns '' "
  copysName := copysName asSymbol.
  copysName = originalName ifTrue: [^ self].
  (Smalltalk includesKey: copysName)
  ifTrue: [^ self error: copysName , ' already exists'].
  oldDefinition := self selectedClass definition.
  newDefinition := oldDefinition copyReplaceAll: '#' , originalName asString with: '#' , copysName asString.
  Cursor wait
+ showWhile: [| class |
+ class := Compiler evaluate: newDefinition logged: true.
- showWhile: [class := Compiler evaluate: newDefinition logged: true.
  class copyAllCategoriesFrom: (Smalltalk at: originalName).
  class class copyAllCategoriesFrom: (Smalltalk at: originalName) class].
  self classListIndex: 0.
  self changed: #classList!

Item was changed:
  ----- Method: ChangeList>>removeExistingMethodVersions (in category 'menu actions') -----
  removeExistingMethodVersions
  "Remove all up to date version of entries from the receiver"
+ | newChangeList newList |
- | newChangeList newList str keep cls sel |
  newChangeList := OrderedCollection new.
  newList := OrderedCollection new.
 
  changeList with: list do:[:chRec :strNstamp |
+ | str keep cls sel |
  keep := true.
  (cls := chRec methodClass) ifNotNil:[
  str := chRec string.
  sel := cls parserClass new parseSelector: str.
  keep := (cls sourceCodeAt: sel ifAbsent:['']) asString ~= str.
  ].
  keep ifTrue:[
  newChangeList add: chRec.
  newList add: strNstamp]].
  newChangeList size < changeList size
  ifTrue:
  [changeList := newChangeList.
  list := newList.
  listIndex := 0.
  listSelections := Array new: list size withAll: false].
  self changed: #list!

Item was changed:
  ----- Method: ObjectExplorer>>step (in category 'monitoring') -----
  step
  "If there's anything in my monitor list, see if the strings have changed."
+ | changes |
- | string changes |
  changes := false.
  self monitorList keysAndValuesDo: [ :k :v |
  k ifNotNil: [
+ | string |
  k refresh.
  (string := k asString) ~= v ifTrue: [ self monitorList at: k put: string. changes := true ].
  ]
  ].
  changes ifTrue: [ | sel |
  sel := currentSelection.
  self changed: #getList.
  self noteNewSelection: sel.
  ].
  self monitorList isEmpty ifTrue: [ ActiveWorld stopStepping: self selector: #step ].!

Item was changed:
  ----- Method: MessageNames>>computeSelectorListFromSearchString (in category 'search') -----
  computeSelectorListFromSearchString
  "Compute selector list from search string"
- | raw sorted |
  searchString := searchString asString copyWithout: $ .
  selectorList := Cursor wait
+ showWhile: [
+ | raw sorted |
+ raw := Symbol selectorsContaining: searchString.
- showWhile: [raw := Symbol selectorsContaining: searchString.
  sorted := raw as: SortedCollection.
  sorted
  sortBlock: [:x :y | x asLowercase <= y asLowercase].
  sorted asArray].
  selectorList size > 19
  ifFalse: ["else the following filtering is considered too expensive. This 19  
  should be a system-maintained Parameter, someday"
  selectorList := self systemNavigation allSelectorsWithAnyImplementorsIn: selectorList].
  ^ selectorList!

Item was changed:
  ----- Method: CodeHolder>>categoryFromUserWithPrompt:for: (in category 'categories') -----
  categoryFromUserWithPrompt: aPrompt for: aClass
  "self new categoryFromUserWithPrompt: 'testing' for: SystemDictionary"
 
+ |  labels myCategories reject lines newName menuIndex |
- |  labels myCategories reject lines cats newName menuIndex |
  labels := OrderedCollection with: 'new...'.
  labels addAll: (myCategories := aClass organization categories asSortedCollection:
  [:a :b | a asLowercase < b asLowercase]).
  reject := myCategories asSet.
  reject
  add: ClassOrganizer nullCategory;
  add: ClassOrganizer default.
  lines := OrderedCollection with: 1 with: (myCategories size + 1).
 
  aClass allSuperclasses do:
  [:cls |
+ | cats |
  cats := cls organization categories reject:
  [:cat | reject includes: cat].
  cats isEmpty ifFalse:
  [lines add: labels size.
  labels addAll: (cats asSortedCollection:
  [:a :b | a asLowercase < b asLowercase]).
  reject addAll: cats]].
 
  newName := (labels size = 1 or:
  [menuIndex := (UIManager default chooseFrom: labels lines: lines title: aPrompt).
  menuIndex = 0 ifTrue: [^ nil].
  menuIndex = 1])
  ifTrue:
  [UIManager default request: 'Please type new category name'
  initialAnswer: 'category name']
  ifFalse:
  [labels at: menuIndex].
  ^ newName ifNotNil: [newName asSymbol]!

Item was changed:
  ----- Method: FileContentsBrowser>>modifiedClassDefinition (in category 'diffs') -----
  modifiedClassDefinition
  | pClass rClass old new diff |
  pClass := self selectedClassOrMetaClass.
  pClass hasDefinition ifFalse:[^pClass definition].
  rClass := Smalltalk at: self selectedClass name asSymbol ifAbsent:[nil].
  rClass isNil ifTrue:[^pClass definition].
  self metaClassIndicated ifTrue:[ rClass := rClass class].
  old := rClass definition.
  new := pClass definition.
+ diff := Cursor wait showWhile:[
+ ClassDiffBuilder buildDisplayPatchFrom: old to: new
- Cursor wait showWhile:[
- diff := ClassDiffBuilder buildDisplayPatchFrom: old to: new
  ].
  ^diff!

Item was changed:
  ----- Method: ChangeList>>browseCurrentVersionsOfSelections (in category 'menu actions') -----
  browseCurrentVersionsOfSelections
  "Opens a message-list browser on the current in-memory versions of all methods that are currently seleted"
+ | aList |
- |  aClass aChange aList |
-
  aList := OrderedCollection new.
  Cursor read showWhile: [
  1 to: changeList size do: [:i |
  (listSelections at: i) ifTrue: [
+ |  aClass aChange |
  aChange := changeList at: i.
  (aChange type = #method
  and: [(aClass := aChange methodClass) notNil
  and: [aClass includesSelector: aChange methodSelector]])
  ifTrue: [
  aList add: (
  MethodReference new
  setStandardClass: aClass  
  methodSymbol: aChange methodSelector
  )
  ]]]].
 
  aList size == 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
  MessageSet
  openMessageList: aList
  name: 'Current versions of selected methods in ', file localName!

Item was changed:
  ----- Method: ProtocolBrowser>>initListFrom:highlighting: (in category 'private') -----
  initListFrom: selectorCollection highlighting: aClass
  "Make up the messageList with items from aClass in boldface."
- | defClass item |
-
  messageList := OrderedCollection new.
  selectorCollection do: [ :selector |  
+ | defClass item |
  defClass := aClass whichClassIncludesSelector: selector.
  item := selector, '     (' , defClass name , ')'.
  defClass == aClass ifTrue: [item := item asText allBold].
  messageList add: (
  MethodReference new
  setClass: defClass
  methodSymbol: selector
  stringVersion: item
  )
  ].
  selectedClass := aClass.!

Item was changed:
  ----- Method: SelectorBrowser>>contents:notifying: (in category 'as yet unclassified') -----
  contents: aString notifying: aController
  "Take what the user typed and find all selectors containing it"
 
+ | tokens |
- | tokens raw sorted |
  contents := aString.
  classList := #().  classListIndex := 0.
  selectorIndex := 0.
  tokens := contents asString findTokens: ' .'.
  selectorList := Cursor wait showWhile: [
+ | raw sorted |
  tokens size = 1
  ifTrue: [raw := (Symbol selectorsContaining: contents asString).
  sorted := raw as: SortedCollection.
  sorted sortBlock: [:x :y | x asLowercase <= y asLowercase].
  sorted asArray]
  ifFalse: [self quickList]]. "find selectors from a single example of data"
  self changed: #messageList.
  self changed: #classList.
  ^ true!

Item was changed:
  ----- Method: Browser>>recategorizeMethodSelector: (in category 'message category list') -----
  recategorizeMethodSelector: sel
  "Categorize method named sel by looking in parent classes for a
  method category.
  Answer true if recategorized."
- | thisCat |
  self selectedClassOrMetaClass allSuperclasses
  do: [:ea |
+ | thisCat |
  thisCat := ea organization categoryOfElement: sel.
  (thisCat ~= ClassOrganizer default
  and: [thisCat notNil])
  ifTrue: [self classOrMetaClassOrganizer classify: sel under: thisCat.
  self changed: #messageCategoryList.
  ^ true]].
  ^ false!

Item was changed:
  ----- Method: CodeHolder>>copyUpOrCopyDown (in category 'commands') -----
  copyUpOrCopyDown
  "Used to copy down code from a superclass to a subclass or vice-versa in one easy step, if you know what you're doing.  Prompt the user for which class to copy down or copy up to, then spawn a fresh browser for that class, with the existing code planted in it, and with the existing method category also established."
 
+ | aClass aSelector allClasses implementors aMenu |
- | aClass aSelector allClasses implementors aMenu aColor |
  Smalltalk isMorphic ifFalse: [^ self inform:
  'Sorry, for the moment you have to be in
  Morphic to use this feature.'].
 
  ((aClass := self selectedClassOrMetaClass) isNil or: [(aSelector := self selectedMessageName) == nil])
  ifTrue: [^ Beeper beep].
 
  allClasses := self systemNavigation hierarchyOfClassesSurrounding: aClass.
  implementors := self systemNavigation hierarchyOfImplementorsOf: aSelector forClass: aClass.
  aMenu := MenuMorph new defaultTarget: self.
  aMenu title:
  aClass name, '.', aSelector, '
  Choose where to insert a copy of this method
  (blue = current, black = available, red = other implementors'.
  allClasses do:
  [:cl |
+ | aColor |
  aColor := cl == aClass
  ifTrue: [#blue]
  ifFalse:
  [(implementors includes: cl)
  ifTrue: [#red]
  ifFalse: [#black]].
  (aColor == #red)
  ifFalse:
  [aMenu add: cl name selector: #spawnToClass: argument: cl]
  ifTrue:
  [aMenu add: cl name selector: #spawnToCollidingClass: argument: cl].
  aMenu lastItem color: (Color colorFrom: aColor)].
  aMenu popUpInWorld!

Item was changed:
  ----- Method: Browser>>createHierarchyTreeOf: (in category 'class list') -----
  createHierarchyTreeOf: col
 
  "Create a tree from a flat collection of classes"
+ | transformed |
- | childs transformed val indexes |
  transformed := col collect: [:ea |
+ | childs indexes |
  childs := col select: [:class | class isTrait not and: [class superclass = ea]].
  indexes := childs collect: [:child | col indexOf: child].
  ea -> indexes].
  transformed copy do: [:ea |
  ea value: (ea value collect: [:idx |
+ | val |
  val := transformed at: idx.
  transformed at: idx put: nil.
  val])].
  ^ transformed select: [:ea | ea notNil].
  !

Item was changed:
  ----- Method: Browser>>createInstVarAccessors (in category 'class functions') -----
  createInstVarAccessors
  "Create getters and setters for all inst vars defined at the level of the current class selection, except do NOT clobber or override any selectors already understood by the instances of the selected class"
 
+ | aClass |
- | aClass newMessage setter |
  (aClass := self selectedClassOrMetaClass) ifNotNil:
  [aClass instVarNames do:
  [:aName |
+ | newMessage setter |
  (aClass canUnderstand: aName asSymbol)
  ifFalse:
  [newMessage := aName, '
  "Answer the value of ', aName, '"
 
  ^ ', aName.
  aClass compile: newMessage classified: 'accessing' notifying: nil].
  (aClass canUnderstand: (setter := aName, ':') asSymbol)
  ifFalse:
  [newMessage := setter, ' anObject
  "Set the value of ', aName, '"
 
  ', aName, ' := anObject'.
  aClass compile: newMessage classified: 'accessing' notifying: nil]]]!