The Trunk: Tools-mt.982.mcz

Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.982.mcz

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

Name: Tools-mt.982
Author: mt
Time: 13 July 2020, 11:49:22.018623 am
UUID: 870fe86a-ad9d-c34d-9103-645414fb1259
Ancestors: Tools-mt.981

Complements ST80-mt.256

=============== Diff against Tools-mt.981 ===============

Item was changed:
  ----- Method: Browser>>buildAndOpenFullBrowser (in category 'toolbuilder') -----
  buildAndOpenFullBrowser
  "assemble the spec for a full system browser, build it and open it"
 
+ | builder window |
- | builder  windowSpec |
  builder := ToolBuilder default.
 
  "the build-but-don't-open phase is factored out to support the prototypicalToolWindow facility"
+ window := self buildDefaultBrowserWith: builder.
+ builder open: window.!
- windowSpec := self buildDefaultBrowserWith: builder.
- builder open: windowSpec.
-
- ^self
- !

Item was changed:
  ----- Method: CustomMenu>>build (in category 'private') -----
  build
  "Turn myself into an invokable ActionMenu."
 
  | stream |
  stream := WriteStream on: (String new).
  labels do: [:label | stream nextPutAll: label; cr].
  (labels isEmpty) ifFalse: [stream skip: -1].  "remove final cr"
  super labels: stream contents
+ font: Preferences standardMenuFont
- font: MenuStyle defaultFont
  lines: dividers!

Item was changed:
  ----- Method: HierarchyBrowser>>buildAndOpenBrowserLabel: (in category 'toolbuilder') -----
  buildAndOpenBrowserLabel: aLabelString
  "assemble the spec for a class list/hierarchy browser, build it and open it"
 
+ | builder window |
- | builder  windowSpec |
  builder := ToolBuilder default.
 
+ window := self buildDefaultBrowserWith: builder.
+ aLabelString ifNotNil: [:str | window label: str].
- windowSpec := self buildDefaultBrowserWith: builder.
- aLabelString ifNotNil:[:str| windowSpec label: str].
 
+ builder open: window.!
- builder open: windowSpec.
-
- ^self
- !

Item was changed:
  Object subclass: #PopUpMenu
  instanceVariableNames: 'labelString font lineArray frame form marker selection'
+ classVariableNames: 'CacheMenuForms'
- classVariableNames: 'CacheMenuForms MenuStyle'
  poolDictionaries: ''
  category: 'Tools-Menus'!
 
  !PopUpMenu commentStamp: '<historical>' prior: 0!
  I represent a list of items. My instances are presented on the display screen in a rectangular area. The user points to an item, pressing a mouse button; the item is highlighted. When the button is released, the highlighted item indicates the selection.!

Item was removed:
- ----- Method: PopUpMenu class>>alignment (in category 'class initialization') -----
- alignment
-
- ^ MenuStyle alignment!

Item was removed:
- ----- Method: PopUpMenu class>>alignment: (in category 'class initialization') -----
- alignment: anAlignment
-
- ^ MenuStyle alignment: anAlignment!

Item was removed:
- ----- Method: PopUpMenu class>>initialize (in category 'class initialization') -----
- initialize  "PopUpMenu initialize"
- (MenuStyle := TextStyle default copy)
- gridForFont: TextStyle default defaultFontIndex withLead: 0;
- centered.
- PopUpMenu allSubInstancesDo: [:m | m rescan]!

Item was changed:
  ----- Method: PopUpMenu class>>labels:lines: (in category 'instance creation') -----
  labels: aString lines: anArray
  "Answer an instance of me whose items are in aString, with lines drawn
  after each item indexed by anArray."
 
  ^ self new
  labels: aString
+ font: Preferences standardMenuFont
- font: MenuStyle defaultFont
  lines: anArray!

Item was removed:
- ----- Method: PopUpMenu class>>leftFlush (in category 'class initialization') -----
- leftFlush
-
- MenuStyle leftFlush!

Item was removed:
- ----- Method: PopUpMenu class>>setMenuFontTo: (in category 'class initialization') -----
- setMenuFontTo: aFont
- "Set the menu font as indicated"
-
- MenuStyle := TextStyle fontArray: { aFont }.
- MenuStyle
- gridForFont: 1 withLead: 0;
- centered.
- self allSubInstancesDo: [:m | m rescan]!

Item was added:
+ ----- Method: PopUpMenu class>>standardMenuStyle (in category 'class initialization') -----
+ standardMenuStyle
+
+ ^ (TextStyle fontArray: { Preferences standardMenuFont })
+ gridForFont: 1 withLead: 0;
+ centered;
+ yourself!

Item was changed:
  ----- Method: PopUpMenu>>computeForm (in category 'private') -----
  computeForm
  "Compute and answer a Form to be displayed for this menu."
 
+ | borderInset paraForm menuForm menuStyle inside |
- | borderInset paraForm menuForm inside |
  borderInset := 4@4.
+ menuStyle := self class standardMenuStyle.
+ paraForm := ((DisplayText text: labelString asText textStyle: menuStyle)
- paraForm := ((DisplayText text: labelString asText textStyle: MenuStyle)
  foregroundColor: (self userInterfaceTheme textColor ifNil: [Color black])
  backgroundColor: (self userInterfaceTheme color ifNil: [Color white])) form.
  menuForm := Form extent: paraForm extent + (borderInset * 2) depth: paraForm depth.
        menuForm fill: (0 @ 0 extent: menuForm  extent)
                          rule: Form over
                          fillColor: (self userInterfaceTheme color ifNil: [Color white]).
  menuForm
  border: menuForm boundingBox
  width: 2
  fillColor: (self userInterfaceTheme borderColor ifNil: [Color black]).
 
  paraForm displayOn: menuForm at: borderInset.
  lineArray == nil ifFalse:
  [lineArray do:
  [ :line |
  menuForm
  fill: (4 @ ((line * font height) + borderInset y)
  extent: (menuForm width - 8 @ 1))
  rule: Form over
  fillColor: (self userInterfaceTheme lineColor ifNil: [Color black])]].
 
  frame := Quadrangle new.
  frame region: menuForm boundingBox.
  frame borderWidth: 4.
  inside := frame inside.
+ marker := inside topLeft extent: (inside width @ menuStyle lineGrid).
- marker := inside topLeft extent: (inside width @ MenuStyle lineGrid).
  selection := 1.
 
  ^ form := menuForm
  !

Item was changed:
  ----- Method: PopUpMenu>>displayAt:withCaption:during: (in category 'displaying') -----
  displayAt: aPoint withCaption: captionOrNil during: aBlock
  "Display the receiver just to the right of aPoint while aBlock is evaluated.  If the receiver is forced off screen, display it just to the right."
  | delta savedArea captionForm captionSave outerFrame captionText tFrame frameSaveLoc captionBox |
  marker ifNil: [self computeForm].
  frame := frame align: marker leftCenter with: aPoint + (2@0).
  outerFrame := frame.
  captionOrNil notNil ifTrue:
  [captionText := (DisplayText
  text: captionOrNil asText
+ textStyle: self class standardMenuStyle copy centered)
- textStyle: MenuStyle copy centered)
  foregroundColor: (self userInterfaceTheme textColor ifNil: [Color black])
  backgroundColor: (self userInterfaceTheme color ifNil: [Color white]).
  tFrame := captionText boundingBox insetBy: -2.
  outerFrame := frame merge: (tFrame align: tFrame bottomCenter
  with: frame topCenter + (0@2))].
  delta := outerFrame amountToTranslateWithin: Display boundingBox.
  frame right > Display boundingBox right
  ifTrue: [delta := 0 - frame width @ delta y].
  frame := frame translateBy: delta.
  captionOrNil notNil ifTrue:
  [captionForm := captionText form.
  captionBox := captionForm boundingBox expandBy: 4.
  captionBox := captionBox align: captionBox bottomCenter
  with: frame topCenter + (0@2).
  captionSave := Form fromDisplay: captionBox.
  Display border: captionBox width: 4 fillColor: (self userInterfaceTheme color ifNil: [Color white]).
  Display border: captionBox width: 2 fillColor: (self userInterfaceTheme textColor ifNil: [Color black]).
  captionForm displayAt: captionBox topLeft + 4].
  marker := marker align: marker leftCenter with: aPoint + delta +  (2@0).
  savedArea := Form fromDisplay: frame.
  self menuForm displayOn: Display at: (frameSaveLoc := frame topLeft).
  selection ~= 0 ifTrue: [Display reverse: marker].
  Cursor normal showWhile: aBlock.
  savedArea displayOn: Display at: frameSaveLoc.
  captionOrNil notNil ifTrue:
  [captionSave displayOn: Display at: captionBox topLeft]!

Item was changed:
  ----- Method: PopUpMenu>>frameHeight (in category 'accessing') -----
  frameHeight
  "Designed to avoid the entire frame computation (includes MVC form),
  since the menu may well end up being displayed in Morphic anyway."
  | nItems |
  frame ifNotNil: [^ frame height].
  nItems := 1 + (labelString occurrencesOf: Character cr).
+ ^ (nItems * self class standardMenuStyle lineGrid) + 4 "border width"!
- ^ (nItems * MenuStyle lineGrid) + 4 "border width"!

Item was changed:
  ----- Method: PopUpMenu>>rescan (in category 'private') -----
  rescan
  "Cause my form to be recomputed after a font change."
 
  labelString == nil ifTrue: [labelString := 'NoText!!'].
+ self labels: labelString font: Preferences standardMenuFont lines: lineArray.
- self labels: labelString font: (MenuStyle fontAt: 1) lines: lineArray.
  frame := marker := form := nil.
 
  "PopUpMenu allSubInstancesDo: [:m | m rescan]"!