The Trunk: ST80-mt.256.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: ST80-mt.256.mcz

commits-2
Marcel Taeumel uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-mt.256.mcz

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

Name: ST80-mt.256
Author: mt
Time: 13 July 2020, 11:48:31.957623 am
UUID: 354bbbf1-f342-ca44-92c6-f5556433cecc
Ancestors: ST80-mt.255

Makes MVC lists, window titles, menus, and "dialogs" aware of demo/hi-dpi mode.

=============== Diff against ST80-mt.255 ===============

Item was changed:
  Paragraph subclass: #ListParagraph
  instanceVariableNames: ''
+ classVariableNames: ''
- classVariableNames: 'ListStyle'
  poolDictionaries: ''
  category: 'ST80-Support'!
 
  !ListParagraph commentStamp: '<historical>' prior: 0!
  I represent a special type of Paragraph that is used in the list panes of a browser.  I  avoid all the composition done by more general Paragraphs, because I know the structure of my Text.!

Item was removed:
- ----- Method: ListParagraph class>>initialize (in category 'initialization') -----
- initialize
- "ListParagraph initialize"
- | aFont |
- "Allow different line spacing for lists"
- aFont := Preferences standardListFont.
- ListStyle := TextStyle fontArray: { aFont }.
- ListStyle gridForFont: 1 withLead: 1!

Item was changed:
  ----- Method: ListParagraph class>>standardListStyle (in category 'style') -----
  standardListStyle
+
+ ^ (TextStyle fontArray: { Preferences standardListFont })
+ gridForFont: 1 withLead: 1;
+ yourself!
- ^ ListStyle!

Item was changed:
  ----- Method: ListParagraph class>>withArray:style: (in category 'instance creation') -----
  withArray: anArray style: aTextStyleOrNil
  "Convert an array of strings into a ListParagraph using the given TextStyle."
 
  aTextStyleOrNil
+ ifNil: [^ (super withText: Text new style: self standardListStyle) withArray: anArray]
- ifNil: [^ (super withText: Text new style: ListStyle) withArray: anArray]
  ifNotNil: [^ (super withText: Text new style: aTextStyleOrNil) withArray: anArray].
  !

Item was changed:
  ----- Method: MVCProject>>jumpToProject (in category 'utilities') -----
  jumpToProject
  "Present a list of potential projects and enter the one selected.
  We use mvcStartUpLeftFlush for possibly no longer valid historical reasons"
 
  "Project current jumpToProject"
 
+ self jumpToSelection: (self buildJumpToMenu: CustomMenu new) startUp!
- self jumpToSelection: (self buildJumpToMenu: CustomMenu new) mvcStartUpLeftFlush!

Item was changed:
  ----- Method: PopUpMenu>>computeLabelParagraph (in category '*ST80-Support') -----
  computeLabelParagraph
  "Answer a Paragraph containing this menu's labels, one per line and centered."
 
+ ^ Paragraph withText: labelString asText style: self class standardMenuStyle!
- ^ Paragraph withText: labelString asText style: MenuStyle!

Item was removed:
- ----- Method: PopUpMenu>>mvcStartUpLeftFlush (in category '*ST80-Menus') -----
- mvcStartUpLeftFlush
- "Build and invoke this menu with no initial selection.  By Jerry Archibald, 4/01.
- If in MVC, align menus items with the left margin.
- Answer the selection associated with the menu item chosen by the user or nil if none is chosen.  
- The mechanism for getting left-flush appearance in mvc leaves a tiny possibility for misadventure: if the user, in mvc, puts up the jump-to-project menu, then hits cmd period while it is up, then puts up a second jump-to-project menu before dismissing or proceeding through the debugger, it's possible for mvc popup-menus thereafter to appear left-aligned rather than centered; this very unlikely condition can be cleared by evaluating 'PopUpMenu alignment: 2'"
-
- | saveAlignment |
- saveAlignment := PopUpMenu alignment.
- PopUpMenu leftFlush.
- ^[self startUp] ensure:
- [PopUpMenu alignment: saveAlignment]!

Item was changed:
  View subclass: #StandardSystemView
  instanceVariableNames: 'labelFrame labelText isLabelComplemented savedSubViews minimumSize maximumSize collapsedViewport expandedViewport labelBits windowBits bitsValid updatablePanes'
+ classVariableNames: 'CacheBits'
- classVariableNames: 'CacheBits LabelStyle'
  poolDictionaries: ''
  category: 'ST80-Support'!
 
  !StandardSystemView commentStamp: '<historical>' prior: 0!
  I represent a view that has a label above its top left corner. The text in the label identifies the kind of view. In addition to a label, I add control over the maximum and minimum size of the display box of my instance. My default controller is StandardSystemController. The elements of ScheduledControllers, the sole instance of ControlManager, are usually controllers for instances of me.!

Item was changed:
  ----- Method: StandardSystemView class>>initialize (in category 'class initialization') -----
  initialize "StandardSystemView initialize"
+ self doCacheBits.!
- self doCacheBits.
- self setLabelStyle!

Item was removed:
- ----- Method: StandardSystemView class>>setLabelStyle (in category 'class initialization') -----
- setLabelStyle
- | aFont |
- "StandardSystemView setLabelStyle"
- aFont := Preferences windowTitleFont.
- LabelStyle := TextStyle fontArray: { aFont }.
- LabelStyle gridForFont: 1 withLead: 0!

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

Item was changed:
  ----- Method: StandardSystemView>>label: (in category 'label access') -----
  label: aString
  "Set aString to be the receiver's label."
  labelText := Paragraph
  withText: (Text fromString: ((aString == nil or: [aString isEmpty])
  ifTrue: ['Untitled' copy]
  ifFalse: [aString]))
+ style: self class standardLabelStyle.
- style: LabelStyle.
  insetDisplayBox == nil ifTrue: [^ self].  "wait for further initialization"
  self setLabelRegion!

Item was changed:
  ----- Method: StandardSystemView>>labelHeight (in category 'label access') -----
  labelHeight
+ ^ ((self class standardLabelStyle fontAt: 1) height + 4) max: 20!
- ^ ((LabelStyle fontAt: 1) height + 4) max: 20!