[ENH] Layouts, take 3.

Mark A. Schwenk mas at wellthot.com
Sun May 21 07:41:08 UTC 2000


Note that the following is for Morphic only:

Change Set:		Layouts
Date:			21 May 2000
Author:			Vassili Bykov <vassili at objectpeople.com>,
			Mark Schwenk <mas at wellthot.com>

I instigated an effort at SqueakEnd to make certain UI elements fixed size so that they would not scale when the window was resized. Here is an implementation by Vassili Bykov of what was discussed: Layouts (an analog of VW's LayoutFrames) and a few base methods fixed to make use of them.  They make buttons and some other UI elements of standard browsers and the debugger fixed size.

Thanks to the SqueakEnd Team, especially Stephen Travis Pope and John Maloney, for the direction for this effort, and to Vassili for the implementation.

In appreciation of Vassili's work, I merged his code with the latest Squeak 2.8a system and extended its use to more varieties of browsers and to the FileList. I hope we can now roll this into the Squeak 2.8a update stream.

And in appreciation to Stephen, this change set also updates the PackageBrowser to use Layouts, DragNDrop, annotation panes, and optional buttons. 

Thanks guys!
-Mark Schwenk
-------------- next part --------------
'From Squeak2.8alpha of 19 January 2000 [latest update: #2158] on 21 May 2000 at 2:35:50 am'!
"Change Set:		Layouts
Date:			21 May 2000
Author:			Vassili Bykov <vassili at objectpeople.com>,
				Mark Schwenk <mas at wellthot.com>

I instigated an effort at SqueakEnd to make certain UI elements fixed size so that they would not scale when the window was resized. Here is an implementation by Vassili Bykov of what was discussed: Layouts (an analog of VW's LayoutFrames) and a few base methods fixed to make use of them.  They make buttons and some other UI elements of standard browsers and the debugger fixed size.

Thanks to the SqueakEnd Team, especially Stephen Travis Pope and John Maloney, for the direction for this effort, and to Vassili for the implementation.

In appreciation of Vassili's work, I merged his code with the latest Squeak 2.8a system and extended its use to more varieties of browsers and to the FileList. I hope we can now roll this into the Squeak 2.8a update stream.

And in appreciation to Stephen, this change set also updates the PackageBrowser to use Layouts, DragNDrop, annotation panes, and optional buttons. 

Thanks guys!!
-Mark Schwenk
"!

Object subclass: #Layout
	instanceVariableNames: 'leftFraction leftOffset topFraction topOffset rightFraction rightOffset bottomFraction bottomOffset '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Support'!

!Layout commentStamp: '<historical>' prior: 0!
Layouts specify position of morphs inside a window using a combination of relative and absolute coordinates. This provides a flexible resize behaviour: components of fixed size, components attached to right or bottom margins of the window, etc. Written by Vassili Bykov, original idea by Stephen Travis Pope (LayoutFrame of ObjectWorks/VisualWorks).

The general idea is the following.  Each of the four edges of the layout (left, top, right, bottom) have two layout attributes: a FRACTION and an OFFSET.  A fraction is a number between 0 and 1, an offset is an integer, possibly negative.  When a morph is positioned, the layout calculates the actual (absolute) coordinates of the morph bounding box WITHIN the bounding box of the containing window.  Each coordinate is derived from the corresponding fraction and the offset as follows. First, the width (for x coordinates) or height (for y coordinates) of the bounding box is divided according to the fraction. Then, offset is added to the result. Finally, the result is added to the left (for x coordinates) or top (for y coordinates) margin of the bounding box.

Instance Variables:
	leftFraction 	(Number)
	leftOffset 	(SmallInteger)
	topFraction 	(Number)
	topOffset 	(SmallInteger)
	rightFraction 	(Number)
	rightOffset 	(SmallInteger)
	bottomFraction 	(Number)
	bottomOffset 	(SmallInteger)

Example layouts:

	Layout
		leftFraction: 0 offset: 0
		topFraction: 0 offset: 0
		rightFraction: 1 offset: 0
		bottomFraction: 1 offset: 0

Positions a morph so it occupies the whole area of the window.  (This layout can also be created as <Layout fractionsLeft: 0 top: 0 right: 1 bottom: 1> or simply <Layout new>).

	Layout
		leftFraction: 0 offset: 20
		topFraction: 0 offset: 10
		rightFraction: 1 offset: -20
		bottomFraction: 1 offset: -10

Positions a morph so it occupies the whole area of the window, with a 10-pixel margin on top and bottom sides and 20-pixel margin on right and left sides.

	Layout
		leftFraction: 0 offset: 0
		topFraction: 0 offset: 0
		rightFraction: 1 offset: 0
		bottomFraction: 0 offset: 20

Positions the morph at the top edge of the window. When the window resizes, the morph stretches horizontally to occupy the whole width of the window but remains fixed size vertically.
!

!Browser methodsFor: 'initialize-release' stamp: 'mas 5/21/2000 00:06'!
openAsMorphClassEditing: editString
	"Create a pluggable version a Browser on just a single class."
	| window switches codePane baseline aTextMorph listFraction buttonHeight textHeight dragNDropFlag |
	listFraction _ 0.4.
	buttonHeight _ Preferences buttonRowHeight.
	textHeight _ Preferences textRowHeight.
	dragNDropFlag _ Preferences browseWithDragNDrop.
	window _ (SystemWindow labelled: 'later') model: self.

	window addMorph: ((PluggableListMorph on: self list: #classListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #classListMenu: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 0.5 offset: 0
			bottomFraction: 0 offset: buttonHeight).
	switches _ self buildMorphicSwitches.
	window addMorph: switches layout:
		(Layout
			leftFraction: 0.5 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 1 offset: 0
			bottomFraction: 0 offset: buttonHeight).
	switches borderWidth: 0.

	window addMorph: ((PluggableMessageCategoryListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: keystroke: #arrowKey:from:
			getRawListSelector: #rawMessageCategoryList) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: buttonHeight
			rightFraction: 0.5 offset: 0
			bottomFraction: listFraction offset: 0).
	window addMorph: ((PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0.5 offset: 0
			topFraction: 0 offset: buttonHeight
			rightFraction: 1 offset: 0
			bottomFraction: listFraction offset: 0).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ 0]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: textHeight).
			baseline _ textHeight].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: baseline
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: baseline + buttonHeight).
			baseline _ baseline + buttonHeight].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: listFraction offset: baseline
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).
	window setUpdatablePanesFrom: #(messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'mas 5/20/2000 23:52'!
openAsMorphEditing: editString
	"Create a pluggable version of all the morphs for a Browser in Morphic"

	| window switches codePane aListMorph baseline aTextMorph listFraction buttonHeight textHeight dragNDropFlag |
	listFraction _ 0.4. "Part of the window taken by lists."
	buttonHeight _ Preferences buttonRowHeight.
	textHeight _ Preferences textRowHeight.
	dragNDropFlag _ Preferences browseWithDragNDrop.
	window _ (SystemWindow labelled: 'later') model: self.

	window addMorph: ((PluggableListMorph on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0 at 0 extent: 0.25 at listFraction).
	window addMorph: ((PluggableListMorph on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0.25 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 0.5 offset: 0
			bottomFraction: listFraction offset: textHeight negated).
	switches _ self buildMorphicSwitches.
	window addMorph: switches layout:
		(Layout
			leftFraction: 0.25 offset: 0
			topFraction: listFraction offset: textHeight negated
			rightFraction: 0.5 offset: 0
			bottomFraction: listFraction offset: 0).
	switches borderWidth: 0.
	window addMorph: ((PluggableMessageCategoryListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: keystroke: #arrowKey:from:
			getRawListSelector: #rawMessageCategoryList) enableDragNDrop: dragNDropFlag)
		frame: (0.5 at 0 extent: 0.25 at listFraction).
	aListMorph _ PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: dragNDropFlag.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0.75 at 0 extent: 0.25 at listFraction).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ 0]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: textHeight).
			baseline _ textHeight].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow 
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: baseline
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: baseline + buttonHeight).
			baseline _ baseline + buttonHeight].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: listFraction offset: baseline
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).
	window setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'mas 5/20/2000 23:34'!
openAsMorphMsgCatEditing: editString
	"Create a pluggable version a Browser on just a messageCategory."
	| window codePane baseline aTextMorph buttonHeight textHeight |
	buttonHeight _ Preferences buttonRowHeight.
	textHeight _ Preferences textRowHeight.
	window _ (SystemWindow labelled: 'later') model: self.

	window addMorph: ((PluggableListMorph on: self list: #messageCatListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #messageCategoryMenu:) enableDragNDrop: Preferences browseWithDragNDrop)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 1 offset: 0
			bottomFraction: 0 offset: textHeight).
	window addMorph: ((PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:) enableDragNDrop: Preferences browseWithDragNDrop)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: textHeight
			rightFraction: 1 offset: 0
			bottomFraction: 0.3 offset: 0).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ 0]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: 0.3 offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: 0.3 offset: textHeight).
			baseline _ textHeight].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: 0.3 offset: baseline
					rightFraction: 1 offset: 0
					bottomFraction: 0.3 offset: baseline + buttonHeight).
			baseline _ baseline + buttonHeight].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0.3 offset: baseline
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).

	window setUpdatablePanesFrom: #(messageCatListSingleton messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'mas 5/21/2000 00:19'!
openAsMorphSysCatEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window switches codePane baseline aTextMorph listFraction dragNDropFlag textHeight buttonHeight |
	listFraction _ 0.3.
	window _ (SystemWindow labelled: 'later') model: self.

	dragNDropFlag _ Preferences browseWithDragNDrop.
	textHeight _ Preferences textRowHeight.
	buttonHeight _ Preferences buttonRowHeight.

	window addMorph: ((PluggableListMorph on: self list: #systemCategorySingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 1 offset: 0
			bottomFraction: 0 offset: textHeight).
	window addMorph: ((PluggableListMorph on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: textHeight
			rightFraction: 1 offset: 0
			bottomFraction: listFraction offset: textHeight negated).
	switches _ self buildMorphicSwitches.
	window addMorph: switches 
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: listFraction offset: textHeight negated
			rightFraction: 0.3333 offset: 0
			bottomFraction: listFraction offset: 0).
	switches borderWidth: 0.
	window addMorph: ((PluggableMessageCategoryListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: keystroke: #arrowKey:from: 
			getRawListSelector: #rawMessageCategoryList) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0.3333 offset: 0
			topFraction: 0 offset: textHeight
			rightFraction: 0.6666 offset: 0
			bottomFraction: listFraction offset: 0).

	window addMorph: ((PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0.6666 offset: 0
			topFraction: 0 offset: textHeight
			rightFraction: 1 offset: 0
			bottomFraction: listFraction offset: 0).

	Preferences useAnnotationPanes
		ifFalse: 	[baseline _ 0]
		ifTrue: [baseline _ textHeight.
			aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: textHeight)].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: baseline
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: baseline + buttonHeight).
			baseline _ baseline + buttonHeight].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: listFraction offset: baseline
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).

	window setUpdatablePanesFrom: #( classList messageCategoryList messageList).
	^ window! !


!ChangeList class methodsFor: 'instance creation' stamp: 'mas 5/21/2000 01:38'!
openAsMorph: aChangeList name: labelString multiSelect: multiSelect
	"Open a morphic view for the messageSet, whose label is labelString.
	The listView may be either single or multiple selection type"
	| window boundary  |
	window _ (SystemWindow labelled: labelString) model: aChangeList.
	Preferences optionalButtons
		ifFalse:
			[boundary _ 0]
		ifTrue:
			[boundary _ Preferences buttonRowHeight.
			window addMorph: aChangeList buttonRowForChangeList
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: 0 offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: 0 offset: Preferences buttonRowHeight)].

	window
		addMorph: ((multiSelect ifTrue: [PluggableListMorphOfMany]
									ifFalse: [PluggableListMorph])
			on: aChangeList list: #list
			selected: #listIndex changeSelected: #toggleListIndex:
			menu: (aChangeList showsVersions ifTrue: [#versionsMenu:] ifFalse: [#changeListMenu:])
				keystroke: nil)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: boundary
			rightFraction: 1 offset: 0
			bottomFraction: 0.4 offset: 0).

	window addMorph: (AcceptableCleanTextMorph on: aChangeList 
			text: #contents accept: #contents:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (0 at 0.4 corner: 1 at 1).
	^ window openInWorld! !


!Debugger methodsFor: 'initialize' stamp: 'mas 5/20/2000 22:45'!
openFullMorphicLabel: labelString
	| window aListMorph codeTopOffset aTextMorph listFraction codeFraction |
	listFraction _ 0.3.
	codeFraction _ 0.7.
	self expandStack.
	window _ (SystemWindow labelled: labelString) model: self.
	aListMorph _ PluggableListMorph on: self list: #contextStackList
			selected: #contextStackIndex changeSelected: #toggleContextStackIndex:
			menu: #contextStackMenu:shifted: keystroke: #contextStackKey:from:.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 1 offset: 0
			bottomFraction: listFraction offset: 0).

	Preferences useAnnotationPanes
		ifFalse:
			[codeTopOffset _ 0]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: Preferences textRowHeight).
			codeTopOffset _ Preferences textRowHeight].

	Preferences optionalButtons ifTrue:
		[window addMorph: self optionalButtonRow
			layout: (Layout
				leftFraction: 0 offset: 0
				topFraction: listFraction offset: codeTopOffset
				rightFraction: 1 offset: 0
				bottomFraction: listFraction offset: codeTopOffset + Preferences buttonRowHeight).
		codeTopOffset _ codeTopOffset + Preferences buttonRowHeight].
	window addMorph: (PluggableTextMorph on: self
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: listFraction offset: codeTopOffset
			rightFraction: 1 offset: 0
			bottomFraction: codeFraction offset: 0).
	window addMorph: (PluggableListMorph on: self receiverInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: codeFraction offset: 0
			rightFraction: 0.2 offset: 0
			bottomFraction: 1 offset: 0).
	window addMorph: (PluggableTextMorph on: self receiverInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		layout: (Layout
			leftFraction: 0.2 offset: 0
			topFraction:  codeFraction offset: 0
			rightFraction: 0.5 offset: 0
			bottomFraction: 1 offset: 0).
	window addMorph: (PluggableListMorph on: self contextVariablesInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:)
		layout: (Layout
			leftFraction: 0.5 offset: 0
			topFraction: codeFraction offset: 0
			rightFraction: 0.7 offset: 0
			bottomFraction: 1 offset: 0).
	window addMorph: (PluggableTextMorph on: self contextVariablesInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		layout: (Layout
			leftFraction: 0.7 offset: 0
			topFraction: codeFraction offset: 0
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).

	^ window openInWorld
! !


!FileList class methodsFor: 'instance creation' stamp: 'mas 5/21/2000 00:48'!
openAsMorph
	"Open a morphic view of a FileList on the default directory."
	| dir aFileList window fileListTop |
	dir _ FileDirectory default.
	aFileList _ self new directory: dir.
	window _ (SystemWindow labelled: dir pathName) model: aFileList.

	window addMorph: ((PluggableListMorph on: aFileList list: #volumeList selected: #volumeListIndex
				changeSelected: #volumeListIndex: menu: #volumeMenu:) autoDeselect: false)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 0.3 offset: 0
			bottomFraction: 0.3 offset: Preferences textRowHeight negated).
	window addMorph: (PluggableTextMorph on: aFileList text: #pattern accept: #pattern:)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0.3 offset: Preferences textRowHeight negated
			rightFraction: 0.3 offset: 0
			bottomFraction: 0.3 offset: 0).
	Preferences optionalButtons
		ifTrue:
			[window addMorph: aFileList optionalButtonRow
				layout: (Layout
					leftFraction: 0.3 offset: 0
					topFraction: 0 offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: 0 offset: Preferences buttonRowHeight).
			fileListTop _ Preferences buttonRowHeight]
		ifFalse:
			[fileListTop _ 0].

	window addMorph: (PluggableListMorph on: aFileList list: #fileList selected: #fileListIndex
				changeSelected: #fileListIndex: menu: #fileListMenu:)
		layout: (Layout
			leftFraction: 0.3 offset: 0
			topFraction: 0 offset: fileListTop
			rightFraction: 1 offset: 0
			bottomFraction: 0.3 offset: 0).
	window addMorph: (PluggableTextMorph on: aFileList text: #contents accept: #put:
			readSelection: #contentsSelection menu: #fileContentsMenu:shifted:)
		frame: (0 at 0.3 corner: 1 at 1).
	^ window! !


!Layout methodsFor: 'initialize-release' stamp: 'vb 3/22/2000 08:48'!
initialize

	leftFraction _ 0.
	topFraction _ 0.
	rightFraction _ 1.
	bottomFraction _ 1.
	leftOffset _ topOffset _ rightOffset _ bottomOffset _ 0! !

!Layout methodsFor: 'accessing' stamp: 'vb 3/14/2000 23:25'!
bottomFraction: aNumber offset: anInteger

	bottomFraction _ aNumber.
	bottomOffset _ anInteger! !

!Layout methodsFor: 'accessing' stamp: 'vb 3/14/2000 23:24'!
leftFraction: aNumber offset: anInteger

	leftFraction _ aNumber.
	leftOffset _ anInteger! !

!Layout methodsFor: 'accessing' stamp: 'vb 3/14/2000 23:24'!
rightFraction: aNumber offset: anInteger

	rightFraction _ aNumber.
	rightOffset _ anInteger! !

!Layout methodsFor: 'accessing' stamp: 'vb 3/14/2000 23:25'!
topFraction: aNumber offset: anInteger

	topFraction _ aNumber.
	topOffset _ anInteger! !

!Layout methodsFor: 'layout' stamp: 'vb 3/22/2000 14:39'!
adjustFrom: currentBounds within: aRectangle
	"The morph has been reframed independently; adjust my setings
	so they reflect the current layout.  For now just adjust the offsets.
	Maybe there is a smarter way to do this (or maybe not)."

	| width height |
	width _ aRectangle width.
	height _ aRectangle height.
	leftOffset _ currentBounds left - aRectangle left - (width * leftFraction).
	rightOffset _ currentBounds right - aRectangle left - (width * rightFraction).
	topOffset _ currentBounds top - aRectangle top - (height * topFraction).
	bottomOffset _ currentBounds bottom - aRectangle top - (height * bottomFraction).

! !

!Layout methodsFor: 'layout' stamp: 'vb 3/28/2000 21:00'!
boundsWithin: aRectangle
	"Answer a Rectangle that represents my layout within the given
	parent bounding box."

	| width height |
	width _ aRectangle width.
	height _ aRectangle height.
	^Rectangle
		left: aRectangle left + (width * leftFraction) truncated + leftOffset
		right: aRectangle left + (width * rightFraction) truncated + rightOffset
		top: aRectangle top + (height * topFraction) truncated + topOffset
		bottom: aRectangle top + (height * bottomFraction) truncated + bottomOffset
		! !


!Layout class methodsFor: 'instance creation' stamp: 'vb 3/22/2000 08:51'!
fractionsLeft: left top: top right: right bottom: bottom

	^super new
		leftFraction: left offset: 0;
		topFraction: top offset: 0;
		rightFraction: right offset: 0;
		bottomFraction: bottom offset: 0! !

!Layout class methodsFor: 'instance creation' stamp: 'vb 3/22/2000 08:51'!
leftFraction: lf offset: lo topFraction: tf offset: to rightFraction: rf offset: ro bottomFraction: bf offset: bo

	^super new
		leftFraction: lf offset: lo;
		topFraction: tf offset: to;
		rightFraction: rf offset: ro;
		bottomFraction: bf offset: bo! !

!Layout class methodsFor: 'instance creation' stamp: 'vb 3/22/2000 08:51'!
leftFraction: lf topFraction: tf rightFraction: rf bottomFraction: bf

	^super new
		leftFraction: lf offset: 0;
		topFraction: tf offset: 0;
		rightFraction: rf offset: 0;
		bottomFraction: bf offset: 0! !

!Layout class methodsFor: 'instance creation' stamp: 'vb 3/22/2000 08:48'!
new

	^super new initialize! !

!Layout class methodsFor: 'instance creation' stamp: 'vb 3/22/2000 08:52'!
offsetsLeft: left top: top right: right bottom: bottom

	^super new
		leftFraction: 0 offset: left;
		topFraction: 0 offset: top;
		rightFraction: 1 offset: right;
		bottomFraction: 1 offset: bottom! !


!MessageSet class methodsFor: 'instance creation' stamp: 'mas 5/20/2000 22:52'!
openAsMorph: aMessageSet name: labelString inWorld: aWorld
	"Create a SystemWindow aMessageSet, with the label labelString."
	| window aListMorph aTextMorph baseline |
	window _ (SystemWindow labelled: labelString) model: aMessageSet.
	aListMorph _ PluggableListMorph on: aMessageSet list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph frame: (0 at 0 extent: 1 at 0.2).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline  _ 0]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: aMessageSet
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: 0.2 offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: 0.2 offset: Preferences textRowHeight).
			baseline _ Preferences textRowHeight].
	Preferences optionalButtons
		ifTrue:
			[window addMorph: aMessageSet optionalButtonRow 
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: 0.2 offset: baseline
					rightFraction: 1 offset: 0
					bottomFraction: 0.2 offset: baseline + Preferences buttonRowHeight).
			baseline _ baseline + Preferences buttonRowHeight].

	window addMorph: (PluggableTextMorph on: aMessageSet 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: 0.2 offset: baseline
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).

	window setUpdatablePanesFrom: #(messageList).
	window openInWorld: aWorld! !


!PackageBrowser methodsFor: 'initialize-release' stamp: 'mas 5/21/2000 01:19'!
openAsMorphEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	"PackageBrowser openBrowser"

	| listFraction buttonHeight window switches codePane aListMorph textHeight baseline aTextMorph dragNDropFlag |
	listFraction _ 0.33.
	buttonHeight _ Preferences buttonRowHeight.
	textHeight _ Preferences textRowHeight.
	dragNDropFlag _ Preferences browseWithDragNDrop.

	window _ (SystemWindow labelled: 'later') model: self.

	window addMorph: ((PluggableListMorph on: self list: #packageList
			selected: #packageListIndex changeSelected: #packageListIndex:
			menu: #packageMenu: keystroke: #packageListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0 at 0 extent: 0.15 at listFraction).

	window addMorph: ((PluggableListMorph on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0.15 at 0 extent: 0.2 at listFraction).

	window addMorph: ((PluggableListMorph on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		layout: (Layout
			leftFraction: 0.35 offset: 0
			topFraction: 0 offset: 0
			rightFraction: 0.6 offset: 0
			bottomFraction: listFraction offset: textHeight negated).
	switches _ self buildMorphicSwitches.
	window addMorph: switches layout:
		(Layout
			leftFraction: 0.35 offset: 0
			topFraction: listFraction offset: textHeight negated
			rightFraction: 0.6 offset: 0
			bottomFraction: listFraction offset: 0).
	switches borderWidth: 0.

	window addMorph: ((PluggableListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu:) enableDragNDrop: dragNDropFlag)
		frame: (0.6 at 0 extent: 0.15 at listFraction).
	aListMorph _ PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: dragNDropFlag.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0.75 at 0 extent: 0.25 at listFraction).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ 0]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: 0
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: textHeight).
			baseline _ textHeight].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow 
				layout: (Layout
					leftFraction: 0 offset: 0
					topFraction: listFraction offset: baseline
					rightFraction: 1 offset: 0
					bottomFraction: listFraction offset: baseline + buttonHeight).
			baseline _ baseline + buttonHeight].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		layout: (Layout
			leftFraction: 0 offset: 0
			topFraction: listFraction offset: baseline
			rightFraction: 1 offset: 0
			bottomFraction: 1 offset: 0).
	window setUpdatablePanesFrom: #(packageList systemCategoryList classList messageCategoryList messageList).
	^ window! !


!Preferences class methodsFor: 'hard-coded prefs' stamp: 'mas 5/20/2000 22:25'!
buttonRowHeight
	"Default height for optional button row."
	^25! !

!Preferences class methodsFor: 'hard-coded prefs' stamp: 'mas 5/20/2000 22:46'!
textRowHeight
	"Default height for text indicators or annotations."
	^20! !


!SystemWindow methodsFor: 'geometry' stamp: 'mas 5/21/2000 02:17'!
setBoundsOfPaneMorphs
	"Lay out morphs in the frame after resizing the frame.
	KLUDGE WARNING: for now, while there are windows in the image with
	old-style Rectangles for layouts, we have to take them into account in the
	block below.  When those are gone, the #respondsTo: test and the ifFalse
	condition can and should go away."

	| panelRect |
	self flag: #kludge.
	panelRect _ self panelRect.
	paneMorphs with: paneRects do:
		[:m :frame |  "m color: paneColor."
		(frame respondsTo: #boundsWithin:)
			ifTrue: [m bounds: (frame boundsWithin: panelRect)]
			ifFalse: [
				m bounds: (((frame scaleBy: panelRect extent) translateBy: panelRect topLeft)) truncated]]! !

!SystemWindow methodsFor: 'geometry' stamp: 'mas 5/21/2000 02:17'!
setPaneRectsFromBounds
	"Reset proportional specs from actual bounds, eg, after reframing panes.
	KLUDGE WARNING: for now, while there are windows in the image with
	old-style Rectangles for layouts, we must to take them into account in the
	block below.  When those are gone, the #respondsTo: test and the ifFalse
	condition can and should go away."

	| panelRect newLayouts |
	self flag: #kludge.
	panelRect _ self panelRect.
	newLayouts _ OrderedCollection new: paneRects size.
	paneMorphs with: paneRects do:
		[:m :frameOrLayout |
		newLayouts add:
			((frameOrLayout respondsTo: #adjustFrom:within:)
				ifTrue: 
					[frameOrLayout adjustFrom: m bounds within: panelRect.
					frameOrLayout]
				ifFalse:
					[(m bounds translateBy: panelRect topLeft negated)
						scaleBy: (1.0 asPoint / panelRect extent)])]! !

!SystemWindow methodsFor: 'panes' stamp: 'vb 3/22/2000 13:09'!
addMorph: aMorph frame: relFrame
	"Provided for compatibility with older purely relative layouts.
	relFrame is a rectangle of Floats specifying fractions."

	self addMorph: aMorph layout: 
		(Layout
			leftFraction: relFrame left
			topFraction: relFrame top
			rightFraction: relFrame right
			bottomFraction: relFrame bottom)
! !

!SystemWindow methodsFor: 'panes' stamp: 'vb 3/28/2000 20:59'!
addMorph: aMorph layout: aLayout

	self addMorph: aMorph.
	paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
	paneRects _ paneRects copyReplaceFrom: 1 to: 0 with: (Array with: aLayout).

	(aMorph isKindOf: BorderedMorph) ifTrue: [aMorph borderWidth: 1].
	aMorph color: self paneColor;
		bounds: (aLayout boundsWithin: self panelRect)
! !


!FlashPlayerWindow methodsFor: 'as yet unclassified' stamp: 'vb 3/28/2000 20:59'!
addMorph: aMorph layout: aLayout
	"Do not change the color"

	self addMorph: aMorph.
	paneMorphs _ paneMorphs copyReplaceFrom: 1 to: 0 with: (Array with: aMorph).
	paneRects _ paneRects copyReplaceFrom: 1 to: 0 with: (Array with: aLayout).
	aMorph borderWidth: 1;
		bounds: (aLayout boundsWithin: self panelRect)
! !

Preferences class removeSelector: #buttonHeight!

!Layout reorganize!
('initialize-release' initialize)
('accessing' bottomFraction:offset: leftFraction:offset: rightFraction:offset: topFraction:offset:)
('layout' adjustFrom:within: boundsWithin:)
!



More information about the Squeak-dev mailing list