78 new updates

Peter William Lount paradigm at unixg.ubc.ca
Tue Mar 16 05:24:46 UTC 1999


Hi Dan,

I got an 'nil does not understand' error updating from server. It looks
like the class named "FlapTab" is undefined before it's used.

 The snippit of code where the error occurs is:
	FlapTab commentStamp: '<historical>' prior: 0

Actually it looks like the "FlapTab" class is not defined at all in the
change set file '661moreFlap-sw.cs' ... (included below)... Please add the
definition to the beginning of the 661 change set file.

Thanks and All the best,

Peter W. Lount
peter at smalltalk.org


'''From Squeak 2.3 of January 14, 1999 on 8 March 1999 at 10:42:34 pm''!
''Change Set:		moreFlap-sw
Date:			8 March 1999
Author:			Scott Wallace

Numerous improvements to flaps.

Adds the ability to have local flaps (which only belong to one project) as
well as global ones.

Adds the alternative of "solid flaps" -- flaps represented by a solid
rectangle of color that spans the length or width of the screen along the
relevant edge.

The preference governing the use of global flaps is changed to
#useGlobalFlaps.''!


!Morph methodsFor: ''accessing'' stamp: ''sw 3/6/1999 02:09''!
highlightColor
	
	| val |
	^ (val _ self valueOfProperty: #highlightColor)
		ifNotNil:
			[val ifNil: [self error: ''nil highlightColor'']]
		ifNil:
			[owner ifNil: [self color] ifNotNil: [owner highlightColor]]! !

!Morph methodsFor: ''accessing'' stamp: ''sw 3/6/1999 02:09''!
regularColor
	
	| val |
	^ (val _ self valueOfProperty: #regularColor)
		ifNotNil:
			[val ifNil: [self error: ''nil regularColor'']]
		ifNil:
			[owner ifNil: [self color] ifNotNil: [owner regularColor]]! !


!FlapTab commentStamp: ''<historical>'' prior: 0!
The tab associated with a flap.  The actual FlapTab is a morph which either
resides directly on the World (if the flap is hidden or if the user chooses
to have the tab be outboard) or as a submorph of the flap, if the flap is
showing and tab-inboard is set.!

!FlapTab reorganize!
(''initialization'' adaptToWorld initialize)
(''access'' flapShowing isGlobal orientation slidesOtherObjects)
(''behavior options'' inboard: toggleInboardness togglePartsBinMode
toggleSlideBehavior)
(''edge'' edgeToAdhereTo edgeToAdhereTo: setEdge: setEdgeToAdhereTo)
(''solid tabs'' applyTabThickness: changeTabSolidity changeTabThickness
spanWorld tabThickness useSolidTab)
(''menu'' addCustomMenuItems:hand: applyThickness: destroyFlap
offerFlapMenu)
(''mouseover & dragover'' arrangeToPopOutOnDragOver:
arrangeToPopOutOnMouseOver: setToPopOutOnDragOver: setToPopOutOnMouseOver:
toggleDragOverBehavior toggleMouseOverBehavior)
(''positioning'' adjustPositionVisAVisFlap mouseMove: mouseUp:
positionObject: positionReferent stickOntoReferent transposeParts)
(''show & hide'' adjustPositionAfterHidingFlap hideFlap
hideFlapUnlessBearingHalo hideFlapUnlessOverReferent
maybeHideFlapOnMouseLeave maybeHideFlapOnMouseLeaveDragging showFlap
tabSelected)
(''textual tabs'' assumeString:font:orientation:color: changeTabText
isCurrentlyTextual useStringTab: useTextualTab)
(''graphical tabs'' isCurrentlyGraphical)
!


!FlapTab methodsFor: ''initialization'' stamp: ''sw 2/26/1999 14:47''!
adaptToWorld
	| wasShowing |
	(wasShowing _ self flapShowing) ifTrue:
					[self hideFlap].
	self spanWorld.
	self positionObject: self.
	wasShowing ifTrue:
		[self showFlap]! !

!FlapTab methodsFor: ''access'' stamp: ''sw 2/26/1999 14:45''!
isGlobal
	^ Utilities globalFlapTabs includes: self! !

!FlapTab methodsFor: ''access'' stamp: ''sw 2/26/1999 20:37''!
orientation
	^ (#(left right) includes: edgeToAdhereTo)
		ifTrue:		[#vertical]
		ifFalse:		[#horizontal]! !

!FlapTab methodsFor: ''edge'' stamp: ''sw 3/2/1999 12:41''!
setEdge: anEdge
	| changedOrientation |
	changedOrientation _ nil.
	self orientation == #vertical
			ifTrue:
				[(#(top bottom) includes: anEdge) ifTrue:
					[changedOrientation _ #horizontal]]
			ifFalse:
				[(#(top bottom) includes: anEdge) ifFalse:
					[changedOrientation _ #vertical]].
	changedOrientation ifNotNil:
		[^ self inform:
''SORRY -- this sort of switch from horiziontal to vertical
or vice-versa is not yet permitted.  For now, to achieve
the desired effect, just to create a new flap and copy over
the elements you want.''].

	self isCurrentlyTextual ifTrue:
		[changedOrientation ifNotNil:
			[self assumeString: (submorphs first contents copyWithout: Character cr)
font: ScriptingSystem fontForScriptorButtons orientation:
changedOrientation color: self color]].

	self edgeToAdhereTo: anEdge.
	changedOrientation ifNotNil:
		[self transposeParts].
	referent isInWorld ifTrue: [self positionReferent].
	self adjustPositionVisAVisFlap
! !

!FlapTab methodsFor: ''edge'' stamp: ''sw 3/5/1999 17:44''!
setEdgeToAdhereTo
	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	#(left top right bottom) do:
		[:sym | aMenu add: sym asString target: self selector:  #setEdge:
argument: sym].
	aMenu popUpAt: self cursorPoint event: self currentEvent! !

!FlapTab methodsFor: ''solid tabs'' stamp: ''sw 2/27/1999 13:16''!
applyTabThickness: newThickness
	(self orientation == #vertical)
			ifTrue:
				[submorphs first width: newThickness asNumber]
			ifFalse:
				[submorphs first height: newThickness asNumber].
	self fitContents.
	self positionReferent. 
	self adjustPositionVisAVisFlap! !

!FlapTab methodsFor: ''solid tabs'' stamp: ''sw 2/27/1999 12:41''!
changeTabSolidity
	self currentHand changeColorTarget: submorphs first selector: #color:! !

!FlapTab methodsFor: ''solid tabs'' stamp: ''sw 2/27/1999 13:14''!
changeTabThickness
	| newThickness |
	newThickness _ FillInTheBlank request: ''New thickness:'' initialAnswer:
self tabThickness printString.
	newThickness size > 0 ifTrue:
		[self applyTabThickness: newThickness]! !

!FlapTab methodsFor: ''solid tabs'' stamp: ''sw 3/2/1999 12:21''!
spanWorld
	| aPoint |
	aPoint _ self currentWorld extent.
	(self orientation == #vertical)
		ifTrue:
			[referent height: aPoint y]
		ifFalse:
			[referent width: aPoint x] ! !

!FlapTab methodsFor: ''solid tabs'' stamp: ''sw 2/27/1999 13:14''!
tabThickness
	^ (self orientation == #vertical)
		ifTrue:
			[self width]
		ifFalse:
			[self height]! !

!FlapTab methodsFor: ''solid tabs'' stamp: ''sw 2/27/1999 13:08''!
useSolidTab
	| aSolid thickness |
	thickness _ 20.
	aSolid _ RectangleMorph newBounds: self currentWorld bounds.
	aSolid color: referent color; borderWidth: 0.
	
	(self orientation == #vertical)
		ifTrue:
			[aSolid width: thickness.
			self position: (self position x @ 0)]
		ifFalse:
			[aSolid height: thickness.
			self position: (0 @ self position y)].

	self replaceSubmorph: submorphs first by: aSolid.
	aSolid position: self position.
	aSolid beSticky.
	self borderWidth: 0.
	self fitContents.
	self layoutChanged.! !

!FlapTab methodsFor: ''menu'' stamp: ''sw 3/6/1999 23:11''!
applyThickness: newThickness
	| toUse |
	toUse _ newThickness asNumber max: 16.
	(self orientation == #vertical)
			ifTrue:
				[referent width: toUse]
			ifFalse:
				[referent height: toUse].
	self positionReferent. 
	self adjustPositionVisAVisFlap! !

!FlapTab methodsFor: ''menu'' stamp: ''sw 2/26/1999 15:06''!
destroyFlap
	| reply request |
	request _ self isGlobal
		ifTrue:
			[''Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
Do you really want to this? '']
		ifFalse:
			[''Caution -- this is permanent!!  Do
you really want to do this? ''].
	reply _ self confirm: request orCancel: [^ self].
	reply ifTrue:
		[self isGlobal
			ifTrue:
				[Utilities removeFlapTab: self]
			ifFalse:
				[referent isInWorld ifTrue: [referent delete].
				self delete]]! !

!FlapTab methodsFor: ''menu'' stamp: ''sw 3/5/1999 17:43''!
offerFlapMenu
	| aMenu |

	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addTitle: ''Flap...''.

	(referent isKindOf: PasteUpMorph) ifTrue: 
		[aMenu add: 
			(referent isPartsBin
				ifTrue:	[''suspend parts-bin behavior'']
				ifFalse:	[''behave like a parts bin''])
			 action: #togglePartsBinMode].

	self isCurrentlyTextual
		ifTrue:
			[aMenu add: ''change tab wording...'' action: #changeTabText.
			aMenu add: ''use graphical tab'' action: #useGraphicalTab.
			aMenu add: ''use solid tab'' action: #useSolidTab]
		ifFalse:
			[aMenu add: ''use textual tab'' action: #useTextualTab.
			self isCurrentlyGraphical
				ifTrue:
					[aMenu add: ''change tab graphic'' action: #changeTabGraphic.
					aMenu add: ''use solid tab'' action: #useSolidTab]
				ifFalse:
					[aMenu add: ''use graphical tab'' action: #useGraphicalTab.
					aMenu add: ''change solid color'' action: #changeTabSolidity.
					aMenu add: ''change tab thickness'' action: #changeTabThickness]].
	aMenu addLine.

	aMenu add: (''toggle dragover (currently '', popOutOnDragOver printString,
'')'') action: #toggleDragOverBehavior.

	aMenu add: (''toggle mouseover (currently '', popOutOnMouseOver
printString, '')'') action: #toggleMouseOverBehavior.
	aMenu add: (''toggle slide (currently '', slidesOtherObjects printString,
'')'') action: #toggleSlideBehavior.
	aMenu add: (''toggle inboardness (currently '', inboard printString,
'')'') action: #toggleInboardness.
	"aMenu add: (''thickness... (currently '', self thickness printString,
'')'') action: #setThickness."
	aMenu add: (''which edge... (currently '', edgeToAdhereTo, '')'') action:
#setEdgeToAdhereTo.
	aMenu addLine.
	aMenu add: ''destroy this flap'' action: #destroyFlap.
	aMenu popUpAt: self cursorPoint event: self currentEvent! !

!FlapTab methodsFor: ''positioning'' stamp: ''sw 3/7/1999 00:26''!
mouseMove: evt
	| aPosition newReferentThickness adjustedPosition |

	((self containsPoint: (aPosition _ evt cursorPoint)) and: [dragged not])
		ifFalse:
			[flapShowing ifFalse:
				[self flag: #deferred.  "Later use this UI to reposition flap in ortho
direction"
				^ self].
			adjustedPosition _ aPosition - evt hand targetOffset.
			(edgeToAdhereTo == #bottom)
				ifTrue:
					[newReferentThickness _ inboard
						ifTrue:
							[self world height - adjustedPosition y]
						ifFalse:
							[self world height - adjustedPosition y - self height]].

			(edgeToAdhereTo == #left)
					ifTrue:
						[newReferentThickness _
							inboard
								ifTrue:
									[adjustedPosition x + self width]
								ifFalse:
									[adjustedPosition x]].

			(edgeToAdhereTo == #right)
					ifTrue:
						[newReferentThickness _
							inboard
								ifTrue:
									[self world width - adjustedPosition x]
								ifFalse:
									[self world width - adjustedPosition x - self width]].

			(edgeToAdhereTo == #top)
					ifTrue:
						[newReferentThickness _
							inboard
								ifTrue:
									[adjustedPosition y + self height]
								ifFalse:
									[adjustedPosition y]].
		

			(#(left right) includes: edgeToAdhereTo)
				ifFalse:
					[self left: adjustedPosition x]
				ifTrue:
					[self top: adjustedPosition y].
			self applyThickness: newReferentThickness.

			dragged _ true]! !

!FlapTab methodsFor: ''positioning'' stamp: ''sw 3/2/1999 12:27''!
transposeParts
	"The receiver''s orientation has just been changed from vertical to
horizontal or vice-versa.  One could imagine trying to be smart about
transposition, though the variety of possibilities is daunting."
	self flag: #deferred.
	"edgeToAdhereTo == #vertical ifTrue: ..."! !

!FlapTab methodsFor: ''show & hide'' stamp: ''sw 3/6/1999 02:08''!
hideFlap
	| aWorld |
	aWorld _ self currentWorld.
	referent privateDelete.
	aWorld removeAccommodationForFlap: self.
	flapShowing _ false.
	self isInWorld ifFalse: [aWorld addMorphFront: self].
	self adjustPositionAfterHidingFlap.
	aWorld haloMorphs do:
		[:m | m target isInWorld ifFalse: [m delete]]! !

!FlapTab methodsFor: ''show & hide'' stamp: ''sw 3/5/1999 17:42''!
maybeHideFlapOnMouseLeaveDragging
	| aWorld |
	self hasHalo ifTrue: [^ self].
	referent isInWorld ifFalse: [^ self].
	(dragged or: [referent bounds containsPoint: self cursorPoint])
		ifTrue:	[^ self].
	aWorld _ self world.
	referent privateDelete.  "could make me worldless if I''m inboard"
	aWorld ifNotNil: [aWorld removeAccommodationForFlap: self].
	flapShowing _ false.
	self isInWorld ifFalse: [aWorld addMorphFront: self].
	self adjustPositionAfterHidingFlap! !

!FlapTab methodsFor: ''textual tabs'' stamp: ''sw 3/6/1999 10:08''!
assumeString: aString font: aFont orientation: anOrientation color: aColor
	| aTextMorph workString pad |
	pad _ (anOrientation == #vertical) 
		ifTrue:	[Character cr]
		ifFalse:	[$ ].
	workString _ pad asString.
	aString do:
		[:ch |
			workString _ workString copyWith: ch.
			workString _ workString copyWith: pad].
	(anOrientation == #vertical)
		ifTrue:
			[workString _ workString copyFrom: 2 to: workString size - 1].

	aTextMorph _ (TextMorph new beAllFont: aFont) width: 10; contents:
workString; yourself.
	self removeAllMorphs.
	self addMorph: aTextMorph centered.
	aTextMorph lock.
	anOrientation == #horizontal
		ifTrue:
			[self borderWidth: 0]
		ifFalse:
			[self borderWidth: 3; borderColor: #raised].
	self fitContents.
	aColor ifNotNil: [self color: aColor].
	aTextMorph position: self position! !

!FlapTab methodsFor: ''textual tabs'' stamp: ''sw 3/6/1999 10:20''!
changeTabText
	| reply longForm existingWording |
	longForm _ submorphs first contents.
	existingWording _ self orientation == #vertical
		ifTrue:
			[longForm asString copyWithout: Character cr]
		ifFalse:
			[(longForm asString collectWithIndex:
				[:ch :i | i even ifFalse: [$ª] ifTrue: [ch]]) copyWithout: $ª]. 

	reply _ FillInTheBlankMorph request: ''new wording for this tab:''
initialAnswer: existingWording centerAt: self cursorPoint inWorld: self
world.
	reply size > 0 ifFalse: [^ self].
	self useStringTab: reply.
	submorphs first delete.
	self assumeString: reply font: ScriptingSystem fontForScriptorButtons
orientation: (Utilities orientationForEdge: edgeToAdhereTo) color: nil! !

!FlapTab methodsFor: ''textual tabs'' stamp: ''sw 2/26/1999 20:42''!
useTextualTab
	submorphs size > 0 ifTrue: [self removeAllMorphs].
	self assumeString: ''Flap'' font: ScriptingSystem fontForScriptorButtons
orientation: self orientation color: Color green muchLighter.
! !

!FlapTab methodsFor: ''graphical tabs'' stamp: ''sw 2/26/1999 18:54''!
isCurrentlyGraphical
	| first |
	^ ((first _ submorphs first) isKindOf: ImageMorph) or: [first isKindOf:
SketchMorph]! !


!HandMorph methodsFor: ''world menu commands'' stamp: ''sw 3/6/1999
09:50''!
offerFlapsMenu
	| aMenu reply showing |
	showing _ Preferences valueOfFlag: #useGlobalFlaps.
	aMenu _ MVCMenuMorph entitled: ''flaps''.
	aMenu add: ''new global flap...''  action: #addGlobalFlap.
	aMenu balloonTextForLastItem: ''Create a new flap that will be shared by
all morphic projects''.

	aMenu add: ''new local flap...''  action: #addLocalFlap.
	aMenu balloonTextForLastItem: ''Create a new flap that will occur only in
this project.''.

	aMenu add:  (showing
							ifTrue: [''stop showing global flaps'']
							ifFalse: [''start showing global flaps''])
		 action: #toggleWhetherToShowFlaps.
	showing
		ifTrue:
			[aMenu balloonTextForLastItem: ''Hide the global flaps, so they do not
show along the edges of morphic projects.''.
			aMenu add: ''bring flaps to front'' action: #bringFlapsToFront.
			aMenu balloonTextForLastItem: ''Makes tabs for all flaps visible.'']
		ifFalse:
			[aMenu balloonTextForLastItem: ''Create a new flap that will be shared
by all morphic projects.''].

	reply _ aMenu invokeAt: self position in: self currentWorld.
	reply ifNotNil: [Utilities perform: reply]
	! !


!PasteUpMorph methodsFor: ''flaps'' stamp: ''sw 3/8/1999 20:22''!
addGlobalFlaps
	"Normally, like all the flap stuff, intended for use only in a World --
but the code for flaps generally put into PasteUpMorph for possible more
general use in future

	Utilities clobberFlapTabList.
	Utilities initializeStandardFlaps.
	self currentWorld deleteAllFlapArtifacts.
	self currentWorld addGlobalFlaps.

"
	| flapList |

	(Preferences valueOfFlag: #useGlobalFlaps) ifFalse: [^ self].
	Smalltalk isMorphic ifFalse: [^ self].
	
	flapList _ Utilities globalFlapTabs.
	flapList do:
		[:aFlapTab |
			(aFlapTab world == self) ifFalse:
				[self addMorphFront: aFlapTab.
				aFlapTab adaptToWorld: self].
			aFlapTab adjustPositionAfterHidingFlap.
			aFlapTab flapShowing ifTrue: [aFlapTab showFlap]]! !

!PasteUpMorph methodsFor: ''flaps'' stamp: ''sw 3/6/1999 21:33''!
assureFlapTabsFitOnScreen
	self submorphs do:
		[:m | (m isKindOf: FlapTab) ifTrue:
			[m orientation == #vertical
				ifTrue:
					[m  y: (m y min: (self bottom - m height))]
				ifFalse:
					[m x: (m x min: (self right - m width))]]]! !

!PasteUpMorph methodsFor: ''flaps'' stamp: ''sw 2/26/1999 16:03''!
deleteGlobalFlapArtifacts
	"self currentWorld deleteGlobalFlapArtifacts"

	| localFlaps |
	localFlaps _ self localFlapTabs collect: [:m | m referent].
	self submorphs do:
		[:m | 
			((m isKindOf: FlapTab) and: [m isGlobal]) ifTrue: [m delete]].
			((m isKindOf: PasteUpMorph) and: [m hasProperty: #flap])
				ifTrue:
					[(localFlaps includes: m) ifFalse: [m delete]]! !

!PasteUpMorph methodsFor: ''flaps'' stamp: ''sw 2/26/1999 15:01''!
localFlapTabs
	| globalList aList aFlapTab |
	globalList _ Utilities globalFlapTabs.
	aList _ OrderedCollection new.
	submorphs do:
		[:m | ((m isKindOf: FlapTab) and: [(globalList includes: m) not])
			ifTrue:
				[aList add: m]
			ifFalse:
				[((m hasProperty: #flap) and:
					[(aFlapTab _ m submorphs detect: [:n | n isKindOf: FlapTab] ifNone:
[nil]) notNil])
						ifTrue:
							[aList add: aFlapTab]]].
	^ aList! !


!PasteUpMorph class methodsFor: ''all'' stamp: ''sw 3/4/1999 15:05''!
authoringPrototype
	"Answer an instance of the receiver suitable for placing in a parts bin
for authors"
	
	| proto |
	proto _ self new markAsPartsDonor.
	proto color: Color green muchLighter;  extent: 100 @ 80; borderColor:
(Color r: 0.645 g: 0.935 b: 0.161).
	proto extent: 300 @ 240.
	proto beSticky.
	^ proto! !


!Preferences class methodsFor: ''initialization'' stamp: ''sw 3/8/1999
14:20''!
chooseInitialSettings
	"Restore the default choices for Preferences."
	"Preferences chooseInitialSettings"
	#(	(allowSoundQuickStart				false)
		(allowSysWindowEmbedding			false)
		(automaticViewerPlacement			true)
		(balloonHelpEnabled					true)
		(browseWithPrettyPrint				false)
		(cmdDotEnabled						true)
		(confirmFirstUseOfStyle				true)
		(disableSounds						false)
		(fastDragWindowForMorphic			false)
		(fenceEnabled						true)
		(ignoreStyleIfOnlyBold				true)
		(inboardScrollbars					false)
		(logDebuggerStackToFile				true)
		(mouseOverHaloseEnabled			false)
		(noviceMode							false)
		(printAlternateSyntax				false)
		(reverseWindowStagger				true)
		(showDebugHaloHandle				true)
		(showDiffsInChangeList				true)
		(showTimeStampsInMenuTitles		false)
		(showProjectZoom					false)
		(suppressCheckForSlips				false)
		(suppressUpdateServerPrompt		false)
		(thoroughSenders					true)
		(unlimitedPaintArea					false)
		(updateSavesFile						false)
		(useAnnotationPanes				false)
		(useGlobalFlaps						true)
		(warnIfNoChangesFile				true)
		(warnIfNoSourcesFile				true))
	do:
		[:aPair |
			aPair last == #true
				ifTrue:
					[self enable: aPair first]
				ifFalse:
					[self disable: aPair first]]

! !

!Preferences class methodsFor: ''initialization'' stamp: ''sw 2/26/1999
15:45''!
initializeHelpMessages
	"Preferences initializeHelpMessages"
  	HelpDictionary _ Dictionary new.
	#(

(allowSoundQuickStart
''If true, attempt to start playing sounds using optional "quick start"'')

(allowSysWindowEmbedding
''Determines whether, in Morphic, SystemWindows should automatically be
droppable into willing receptors'')

(automaticViewerPlacement
''If true, new viewers are automatically positioned near the objects they
view; if false, new viewers are attached to the hand, from whence you much
choose a destination for them'')

(balloonHelpEnabled
''Whether balloon help should be offered when the cursor lingers over
certain objects.'')

(browseWithPrettyPrint
''If true, browsers will automatically format their contents'')

(cautionBeforeClosing 
''If true, Morphic windows seen in an mvc project will put up a warning
before allowing themselves to be dismissed'')

(cmdDotEnabled
''If true, cmd-dot brings up a debugger;
if false, the cmd-dot interrupt is disabled'')

(confirmFirstUseOfStyle
''If true, the first attempt to submit a method with non-standard style
will bring up a confirmation dialog'')

(disableSounds
''If true, all sound playing is disabled'')
	
(editPlayerScriptsInPlace 
''If true, textual player scripts are edited in place in Scriptors (still
imperfectly implemented)'')

(eToyScheme
''If true, new scripting spaces place the Playfield to the left and the the
palette to the right of the window; if false, the opposite is true.'')

(fastDragWindowForMorphic
''If true, morphic window drag will be done by dragging an outline of the
window.'')

(fenceEnabled
''Whether an object obeying motion scripts should stop moving when it
reaches the edge of its container.'')

(ignoreStyleIfOnlyBold
''If true, then any method submission in which the only style change is for
bolding will be treated as a method with no style specifications'')

(inboardScrollbars
''If true, then ScrollPane will place scrollbars inside on the right and
will not hide them on exit'')

(logDebuggerStackToFile
''If true, whenever you fall into a debugger a summary of its stack will be
written to a file named
''''SqueakDebug.log'''''')

(mouseOverHalosEnabled
''If false, halos will not be put up on mouseovers even if they otherwise
might be.'')

(noviceMode 
''If true, certain novice-mode accommodations are made.'')

(printAlternateSyntax
''If true, then
prettyPrint using experimental syntax.
Otherwise use normal ST-80 syntax.'')

(reverseWindowStagger
''If true, a reverse-stagger strategy  is used for determining where newly
launched windows will be placed; if false, a direct- stagger strategy is
used.'')

(showDebugHaloHandle 
''If true, a special debugging halo handle is displayed at the right of the
halo; if false, no such handle is shown.'')

(showDiffsInChangeList
''If true, changeList browsers and Versions browsers reveal the differences
between successive versions or between the in-memory code and the code on
disk'')

(showPlayerSource
''If true, then all Player methods with fewer than 2 arguments are included
in Viewers, whether or not they are intended for end-user use.  This can be
dangerous'')

(showProjectZoom
''If true, then show a zoom effect when entering or leaving projects.  This
can be costly of memory (at least an extra screen buffer) so dont use it in
low space situations.  But it is cool.'')

(showScriptSource
''If true, then the actual Smalltalk source code for methods is shown in
the detail panes for scripts in a viewer; if false, then a help message for
scripts is shown instead.'')

(showTimeStampsInMenuTitles
''If true, then the author''''s timestamp is displayed as the menu title of
any message list; if false, no author''''s timestamps are shown'')

(suppressCheckForSlips 
''If false, then whenever you file out a change set, it is checked for
''''slips'''' and if any are found, you are so informed and given a chance
to open a browser on them'')

(suppressUpdateServerPrompt
''If true, the prompt for server choice when updating code from the server
is suppressed.  Set this to true to leave the server choice unchanged from
update to update.'')

(thoroughSenders
''If true, then ''''senders'''' browsers will dive inside structured
literals in their search'')

(uniformWindowColors
''If true, then all standard windows are given the same color rather than
their customized window-type-specific colors'')

(unlimitedPaintArea
''If true, the painting area for a new drawing will not be limited in size;
if false, a reasonable
limit will be applied, in an attempt to hold down memory and time price.'')

(updateRemoveSequenceNum
''If true, then remove the leading sequence number from the filename before
automatically saving a local copy of any update loaded.'')

(updateSavesFile
''If true, then when an update is loaded from the server, a copy of it will
automatically be saved on a local file as well.'')

(useAnnotationPanes
''If true, a thin horizontal annotation pane is used in message-list
browsers.'')

(useDetailPanesInViewers
''If true, then Viewers will have an extra "¶" control at the left of each
row, the hitting of which toggles the appearance of a textual detail
pane.'')

(useGlobalFlaps
''If true, then flaps are shown along the edges of Morphic projects.'')

(useNewViewers
''If true, then the new kinds of viewers introduced in Squeak 2.3 are used;
if false, then the old style, from earlier releases, are still used.  Old
viewers will hopefully soon be removed from the system.'')

(warnIfNoChangesFile
''If true, then you will be warned, whenever you start up, if no changes
file
can be found'')

(warnIfNoSourcesFile 
''If true, then you will be warned, whenever you start up, if no sources
file can be found'')) do:
		[:pair | HelpDictionary at: pair first put: 
			(pair first, '':
'', pair last)]
! !

!Preferences class methodsFor: ''preferences dictionary'' stamp: ''sw
2/26/1999 16:04''!
noteThatFlag: prefSymbol justChangedTo: aBoolean
	"Provides a hook so that a user''s toggling of a preference might
precipitate some immediate action"
	((prefSymbol == #useGlobalFlaps) and: [Smalltalk isMorphic]) ifTrue:
		[aBoolean
			ifTrue:
				[self currentWorld addGlobalFlaps]
			ifFalse:
				[self currentWorld deleteGlobalFlapArtifacts]]! !


!Utilities class methodsFor: ''miscellaneous'' stamp: ''sw 3/6/1999
10:53''!
addSampleWindowsTo: aPage
	"Add windows representing a browser, a workspace, etc., to aPage"
	|  aWindow pu |
	aWindow _ Browser new openAsMorphEditing: nil.
	aWindow setLabel: ''System Browser''.
	aPage addMorphBack: aWindow applyModelExtent.
	aWindow _ Workspace new embeddedInMorphicWindowLabeled: ''Workspace''.
	aPage addMorphBack: aWindow applyModelExtent.
	aPage addMorphBack: FileList openAsMorph applyModelExtent.

	aPage addMorphBack: DualChangeSorter new morphicWindow applyModelExtent.
	aPage addMorphBack: ChangeSorter new morphicWindow applyModelExtent.

	aWindow _ SelectorBrowser new morphicWindow.
	aWindow setLabel: ''Selector Browser''.
	aPage addMorphBack: aWindow.
	aPage addMorphBack: ((pu _ PasteUpMorph newSticky borderInset)
embeddedInMorphicWindowLabeled: ''assembly'').
	pu color: (Color r: 0.839 g: 1.0 b: 0.935)! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 2/26/1999 15:48''!
addGlobalFlap
	| aMenu reply aFlapTab |
	aMenu _ MVCMenuMorph entitled: ''flaps''.
	#(left right top bottom) do:
		[:sym | aMenu add: sym action: sym].
	reply _ aMenu invokeAt: self currentHand position in: self currentWorld.
	reply ifNotNil:
		[aFlapTab _ self newFlapTitled: ''Fuhlapp'' onEdge: reply.
		self globalFlapTabs add: aFlapTab.
	self currentWorld addGlobalFlaps]
	
! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 2/26/1999 15:15''!
addLocalFlap
	| aMenu reply aFlapTab aWorld |
	aMenu _ MVCMenuMorph entitled: ''Where should the new flap cling?''.
	#(left right top bottom) do:
		[:sym | aMenu add: sym action: sym].
	reply _ aMenu invokeAt: self currentHand position in: self currentWorld.
	reply ifNotNil:
		[aFlapTab _ self newFlapTitled: ''Flap'' onEdge: reply.
		(aWorld _ self currentWorld) addMorphFront: aFlapTab.
		aFlapTab adaptToWorld: aWorld]
	
! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 3/2/1999 11:12''!
explainFlaps
	"Open a window giving flap  help."
	"Utilities explainFlaps"
	| aString |
	aString _ 
''Global flaps, when deployed (by setting the Preference "useGlobalFlaps"
to true, or requesting them via the "flaps" branch of the "windows" menu),
will be available in every morphic project.

Local flaps are flaps that belong to a single morphic project.

If a flap is set up as a parts bin (such as the default Tools and Supplies
flaps), you can use it to create new objects -- just mouse-over the tab so
that the flap will open up, then find the object you want, and drag it;
when the cursor leaves the flap, the flap itself will disappear, and
you''''ll be left holding the new object -- just click to place it exactly
where you want it.

If a flap is *not* set up as a parts bin (such as the default "Squeak" flap
at the left edge of the screen) you can park objects there (this is an easy
way to move objects from project to project) and you can place your own
private controls there, etc.  Everything in the default "Squeak" flap (and
all the other default flaps, for that matter) is there only for
illustrative purposes -- every user will want to fine-tune the flaps to
suit his/her own style and needs.

Each flap may be set up to appear on mouseover, dragover, both, or neither,
and each tab can be positioned either within the showing flap ("inboard")
or outside of it.  See the menu items described below for more about these
and other options.

You can always open a closed flap by clicking on its tab, 
You can always close an open flap by clicking on its tab.

Drag the tab of an open flap to reposition the tab and to resize the flap
itself.  Repositioning starts when you drag the cursor out of the original
tab area.

If flaps or their tabs seem wrongly positioned or lost, try issuing a
restoreDisplay from the Morphic screen menu.

The red-halo menu on a flap gives you access to the "flap..." submenu which
allows you to change its properties:
	
inboard				Governs whether the tab on an open flap is placed within the
flap.
dragover			If true, the flap opens on dragover and closes again on
drag-leave.
mouseover			If true, the flap opens on mouseover and closes again on
mouse-leave. 
slide				If true, when a flap opens, it slides the other objects on the
screen over.
edge				Governs which edge (left, right, top, bottom) the flaps adheres to.

suspend parts bin behavior	Temporarily let a parts-bin flap be editable.
behave like a parts bin		Make the flap again serve as a parts bin.

destroy this flap			Permanently deletes the flap.


textual tabs
	use textual tab			Make the tab be textual.
	change tab wording		Change the wording in a textual tab.

graphical tabs
	use graphical tab		Makes the tab graphical.
	change tab graphic...	Change the graphic of a graphical tab.

solid tabs
	use solid tab			Make the tab be a solid band of color across an edge of
the screen.
	change tab thickness	Change the thickness of a solid tab.


To define a new flap, look under "flaps..." in the "windows... menu.  You
can define a "global" flap, which will appear in every morphic project, or
a "local" flap, which will belong only to the project in which you define
it.

To reinstate the default system flaps, evaluate "Utilities
reinstateDefaultFlaps"  (caveat -- this will first remove all existing
flaps, including any that you may have manually added or edited.)

If flaps that you wish to use appear to be buried behind other objects on
your screen, choose "bring flaps to front" from the flaps... branch of the
windows... menu.

To add, delete, or edit things on a given flap, it is often wise first to
suspend the flap''''s mouse-over and drag-over sensitivity, so it won''''t
keep disappearing on you while you''''re trying to work with it.

Some combinations of settings do not work too happily together.  For
example, solid tabs and inboard tabs do not get along too well, and trying
to make a parts-bin flap be inboard can also lead to problems.

The "Menu" flap provided in the default flap-set provides a service that
will be valuable to some (it gives a sense of place to every standard menu
item, and allows you to avoid navigating through submenus) and dismaying to
others (who should smite the flap immediately -- do this by bringing up the
red-halo menu for the "Menu" tab, choosing "flap", and then choosing
"destroy this flap").

''.
	
  

	(StringHolder new contents: aString)
		openLabel: ''Flaps in Morphic''

	! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 2/26/1999 14:43''!
globalFlapTabs
	FlapTabs ifNil: [self initializeStandardFlaps].
	^ FlapTabs! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 3/6/1999 02:20''!
menuFlap
	| aFlap aFlapTab m |
	aFlap _ PasteUpMorph newSticky color: Color transparent; extent: self
currentWorld width @ 260; borderWidth: 0; padding: 0.

	aFlapTab _ FlapTab new referent: aFlap.
	aFlapTab color: Color brown lighter.
	aFlapTab assumeString: ''Menus'' font: ScriptingSystem
fontForScriptorButtons orientation: #horizontal color: Color blue
muchLighter.
	aFlapTab setToPopOutOnMouseOver: true.
	aFlapTab edgeToAdhereTo: #top; inboard: false.

	aFlapTab position: ((Display width - aFlapTab width) // 2) @ 0.
	aFlap setProperty: #flap toValue: true.
	aFlap color: (Color blue muchLighter alpha: 0.6).
	aFlap extent: self currentWorld width @ 263.

	#(openMenu helpMenu windowsMenu scriptingMenu changesMenu debugMenu) do:
		[:aMenuSymbol |
			aFlap addMorphBack: ((m _ self currentHand perform: aMenuSymbol)
beSticky; stayUp: true).
			m submorphs second delete.
			m borderWidth: 1].
	aFlap laySubpartsOutInOneRow.

	^ aFlapTab! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 3/1/1999 15:45''!
newPartsFlapPage
	| aPage |
	aPage _ PasteUpMorph new borderWidth: 0.
	aPage color: Color white; padding: 6.
	aPage autoLineLayout: true.
	aPage isPartsBin: true; openToDragNDrop: false.
	aPage setProperty: #alwaysShowThumbnail toValue: true.
	^ aPage! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 2/26/1999 15:47''!
reinstateDefaultFlaps
	"Utilities reinstateDefaultFlaps"
	self currentWorld deleteAllFlapArtifacts.
	self clobberFlapTabList.
	self initializeStandardFlaps.
	self currentWorld addGlobalFlaps.
! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 3/6/1999 21:22''!
standardBottomFlap
	|  aFlapTab aPage |
	aPage _ self newPartsFlapPage.
	aPage setProperty: #maximumThumbnailWidth toValue: 80.
	aFlapTab _ FlapTab new referent: aPage beSticky.
	aFlapTab color: Color red lighter.
	aFlapTab setToPopOutOnDragOver: true.
	aFlapTab setToPopOutOnMouseOver: true.
	aFlapTab assumeString: ''Supplies'' font: ScriptingSystem
fontForScriptorButtons orientation: #horizontal color: Color red lighter.
	aFlapTab edgeToAdhereTo: #bottom; inboard: false.

	aPage extent: self currentWorld width @ 100.
	#(PaintInvokingMorph RectangleMorph EllipseMorph StarMorph  CurveMorph
PolygonMorph TextMorph ImageMorph BasicButton
		PasteUpMorph    BookMorph TabbedPalette 
		JoystickMorph  ) do:
		[:sym | aPage addMorphBack: (Smalltalk at: sym) authoringPrototype].

	aPage addMorphBack: TrashCanMorph new markAsPartsDonor.
	aPage addMorphBack: ScriptingSystem scriptControlButtons markAsPartsDonor.
	aPage addMorphBack: Morph new previousPageButton markAsPartsDonor.
	aPage addMorphBack: Morph new nextPageButton markAsPartsDonor.
	aPage addMorphBack: (ClockMorph authoringPrototype showSeconds: false)
step.

	aPage replaceTallSubmorphsByThumbnails.
	aPage fixLayout.

	aFlapTab position: ((Display width - aFlapTab width) // 2 @ (self
currentWorld height - aFlapTab height)).
	aPage setProperty: #flap toValue: true.
	aPage color: (Color red muchLighter "alpha: 0.2").
	aPage extent: self currentWorld width @ 100.
	
	^ aFlapTab! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 3/6/1999 01:47''!
standardLeftFlap
	| aFlap aFlapTab aButton aString aClock buttonColor aFont |

	aFlap _ PasteUpMorph newSticky borderWidth: 0.
	aFlapTab _ FlapTab new referent: aFlap.
	aFlapTab assumeString: ''Squeak'' font: (ScriptingSystem
fontForScriptorButtons) orientation: #vertical color: Color brown lighter
lighter.
	aFlapTab edgeToAdhereTo: #left; inboard: false.
	aFlapTab setToPopOutOnDragOver: true.
	aFlapTab setToPopOutOnMouseOver: true.

	aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)).
	aFlap setProperty: #flap toValue: true.
	aFlap color: (Color brown muchLighter lighter "alpha: 0.3").
	aFlap extent: 200 @ self currentWorld height.

	aButton _ SimpleButtonMorph new target: Project.
	aButton actionSelector: #returnToPreviousProject.
	aFont _ StrikeFont familyName: #ComicBold size: 24.
	aButton label: ''<'' font: aFont; borderWidth: 0.
	aButton firstSubmorph color: Color red lighter.
	aButton beTransparent.
	aButton position: 30 @ 12.
	aButton setBalloonText: ''previous project''.
	aFlap addMorph: aButton.

	aButton _ aButton fullCopy.
	aButton actionSelector: #advanceToNextProject.
	aButton label: ''>'' font: aFont; borderWidth: 0.
	aButton firstSubmorph color: Color red lighter.
	aButton position: 150 @ 14.
	aButton setBalloonText: ''next project''.
	aFlap addMorph: aButton.

	aButton _ aButton fullCopy actWhen: #buttonDown.
	aButton actionSelector: #jumpToProject; target: self currentHand.
	aButton label: ''Go...'' font: (StrikeFont familyName: #ComicBold size:
19); borderWidth: 0.
	aButton position: 78 @ 16.
	aButton firstSubmorph color: Color red lighter.
	aButton setBalloonText: ''go directly to a project''.
	aFlap addMorph: aButton.

	buttonColor _ Color green muchLighter.
	aButton _ SimpleButtonMorph new target: Smalltalk.
	aButton color: buttonColor.
	aButton actionSelector: #saveSession.
	aButton setBalloonText: ''Make a complete snapshot of the current state of
the image onto disk.''.
	aButton label: ''snapshot''.
	aButton position: 70 @ 60.
	aFlap addMorph: aButton.

	aButton _ aButton fullCopy target: Utilities.
	aButton actionSelector: #fileOutChanges.
	aButton label: ''file out changes''.
	aButton setBalloonText: ''File out the current change set to disk.''.
	aButton position: 50 @ 100.
	aFlap addMorph: aButton.

	aButton _ aButton fullCopy target: Utilities.
	aButton actionSelector: #browseRecentSubmissions.
	aButton setBalloonText: ''Open a message-list browser showing the 20
most-recently-submitted methods.''.
	aButton label: ''recent submissions''.
	aButton position: 45 @ 140.
	aFlap addMorph: aButton.

	aClock _ ClockMorph newSticky position: (60 @ 170).
	aClock color: Color red.
	aClock showSeconds: false.
	aClock font: (TextStyle default fontAt: 3).
	aClock setBalloonText: ''The time of day.  If you prefer to see seconds,
check out my menu.''.
	aFlap addMorph: aClock.

	aButton _ aButton fullCopy target: Preferences.
	aButton actionSelector: #openPreferencesInspector.
	aButton setBalloonText: ''Open a window allowing me to view and change
various Preferences.''.
	aButton label: ''preferences...''.
	aButton position: 57 @ 204; color: Color cyan muchLighter.
	aFlap addMorph: aButton.

	aButton _ aButton fullCopy target: Utilities.
	aButton actionSelector: #updateFromServer.
	aButton label: ''load code updates''.
	aButton setBalloonText: ''Check the Squeak server for any new code
updates, and load any that are found.''.
	aButton position: 48 @ 244.
	aFlap addMorph: aButton.

	aString _ UpdatingStringMorph new target: Smalltalk.
	aString useStringFormat; color: Color blue; stepFrequency: 3000;
getSelector: #version.
	aString setBalloonText: ''Indicates the official Squeak release code of
the current image.''.
	aString position: 6 @ 280.
	aFlap addMorph: aString.

	aString _ aString fullCopy getSelector: #lastUpdateString.
	aString setBalloonText: ''Indicates the update number of the last official
update present in the image.''.
	aString top: 300.
	aFlap addMorph: aString.

	aString _ aString fullCopy getSelector: #currentChangeSetString.
	aString setBalloonText: ''Indicates the name of the current change set.''.
	aString top: 320.
	aFlap addMorph: aString.

	aButton _ SimpleButtonMorph new target: self.
	aButton actionSelector: #explainFlaps; color: buttonColor.
	aButton label: ''About flaps...''.
	aButton position: (60 @ 360).
	aButton setBalloonText: ''Click here to get a window of information about
flaps.''.
	aFlap addMorph: aButton.

	aButton _ aButton fullCopy target: Preferences; actionSelector:
#editAnnotations;
		label: ''Annotations...''; position: (60 @ 400).
	aButton setBalloonText: ''Click here to get a little window that will
allow you to specify which types of annotations, in which order, you wish
to see in the annotation pane of method-list browsrs.''.
	aFlap addMorph: aButton.

	aButton _ TrashCanMorph newSticky position: (65 @ 430).
	aFlap addMorph: aButton.
	aButton startStepping.

	^ aFlapTab! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 3/6/1999 01:50''!
standardRightFlap
	|  aFlapTab aPage |
	aPage _ self newPartsFlapPage.
	aFlapTab _ FlapTab new referent: aPage beSticky.
	aFlapTab color: Color red lighter.
	aFlapTab assumeString: ''Tools'' font: ScriptingSystem
fontForScriptorButtons orientation: #vertical color: Color orange lighter.
	aFlapTab edgeToAdhereTo: #right; inboard: false.
	aFlapTab setToPopOutOnDragOver: true.
	aFlapTab setToPopOutOnMouseOver: true.

	aPage extent: (90 @ self currentWorld height).
	self addSampleWindowsTo: aPage.
	aPage addMorphBack: ScriptingSystem newScriptingSpace.
	aPage addMorphBack: RecordingControlsMorph authoringPrototype.
	aPage replaceTallSubmorphsByThumbnails.
	aPage fixLayout.

	aFlapTab position: (self currentWorld width - aFlapTab width) @ ((Display
height - aFlapTab height) // 2).
	aPage setProperty: #flap toValue: true.
	aPage color: (Color brown muchLighter alpha: 0.5).
	aPage extent: (90 @ self currentWorld height).
	
	^ aFlapTab! !

!Utilities class methodsFor: ''flaps'' stamp: ''sw 2/26/1999 15:49''!
toggleWhetherToShowFlaps
	Preferences setPreference: #useGlobalFlaps toValue: Preferences
useGlobalFlaps not! !


!WorldMorph methodsFor: ''initialization'' stamp: ''sw 3/6/1999 23:27''!
restoreDisplay

	self == World ifTrue:  "Else we''re a morphic world-window in an mvc
project and the restoreDisplay was, unusually, issued from the world''s
menu rather than from the mvc screen menu"
		[DisplayScreen startUp.
		self extent: Display extent.
		self viewBox: Display boundingBox.
		self restoreFlapsDisplay].
	self fullRepaintNeeded! !

!WorldMorph methodsFor: ''initialization'' stamp: ''sw 3/6/1999 23:27''!
restoreFlapsDisplay
	Preferences useGlobalFlaps ifTrue:
		[Utilities globalFlapTabs do:
			[:aFlapTab | aFlapTab adaptToWorld]].
	self localFlapTabs do:
			[:aFlapTab | aFlapTab adaptToWorld].
	self assureFlapTabsFitOnScreen.
	self bringFlapTabsToFront! !

!WorldMorph methodsFor: ''install / exit'' stamp: ''sw 3/8/1999 01:43''!
install

	self viewBox: Display boundingBox.
	hands do: [:h | h initForEvents].

	self installFlaps.

	SystemWindow noteTopWindowIn: self.
	self displayWorld.
! !

!WorldMorph methodsFor: ''install / exit'' stamp: ''sw 3/8/1999 00:31''!
installFlaps
	self addGlobalFlaps.
	self localFlapTabs do:
			[:aFlapTab | aFlapTab adaptToWorld].
	self assureFlapTabsFitOnScreen.
	self bringFlapTabsToFront! !


FlapTab removeSelector: #thickness!
FlapTab removeSelector: #setThickness!
FlapTab removeSelector: #popOutOnMouseOver:!
FlapTab removeSelector: #popOutOnDragOver:!
FlapTab removeSelector: #offsetForInsertion!
PasteUpMorph removeSelector: #addFlaps!
Utilities class removeSelector: #addFlap!
Utilities class removeSelector: #flapTabs!
"Postscript:
"
Preferences initializeHelpMessages.
Preferences enable: #useGlobalFlaps.
Preferences deletePreference: #useFlaps.
Utilities reinstateDefaultFlaps.!

'





More information about the Squeak-dev mailing list