HopscotchForHTML5.ns

Newspeak3
'Root'
class HopscotchForHTML5 usingPlatform: p images: is ducts: ds voiceControlClass: VCC
(* :exemplar: platform hopscotch *)
 = Object new (
	(* Hopscotch is Newspeak's UI framework. This version is implemented on top of HTML and CSS.

Copyright Google Inc. 2012 -2017

Copyright Ryan Macnak, Gilad Bracha 2018-2022
Copyright Gilad Bracha 2023-2024

This class defines a UI framework of the Newspeak platform on the web. Of course, one can use the DOM directly (as the code in this class does in its lower layers) or call any desired Javascript framework; but these are unpleasant, and we'd rather pave over the web's native horrors. 

The classes herein can be classified into: 

Windows/Shells
Fragments 
  - Presenters 
  - Composers
Navigation/History
Decorators

The entire process is driven by the window/shell classes. Normally, there is a HopscotchWindow encompassing the entire browser tab. However, one can also embed Hopscotch within HTML, and for this we have EmbeddedHopscotchWindow. Both inherit key behavior from HopscotchShell.

The key entry points are openSubject:, enterSubject:, enterPresenter: and displayPresenter:; these are all methods of the window/shell classes. They call each other in the order listed above. Ultimately, displayPresenter: handles the insertion of a presenter's DOM tree into the actual DOM, so the browser will display it.

Fragments are logical view elements. In Web circles, the fragment tree might be thought of as a shadow-DOM.

Base fragments are defined by Hopscotch and map into DOM elements. The DOM element of a fragment is called its visual. A presenter is a special kind of fragment - essentially a higher-level user-defined fragment. A presenter computes a fragment tree to represent it using its #definition method. This yields a tree of DOM elements that it then inserts into the browser's current document.

Presenters have a slot called #substanceSlot. The substance is the fragment tree for rendering the presenter. It gets initialized lazily by a method called #ensureSubstance. This method runs #definition to compute the fragment tree, hooks up the back pointer from the fragment tree to its parent (the presenter) and calls #noticeSubstanceCreation, which is some sort of hook that lets code respond to this situation. No code uses it.

When a presenter is to be displayed by a HopscotchShell, it is asked for its visual, which is its native widget tree. If the visual has already been computed, it is available in the slot #visualX inherited from Fragment. Otherwise, #createVisual is called, which in turn calls #ensureSubstance.  This in turn will either invoke the #definition method to compute the fragment tree, or reuse the existing tree stored in #substanceSlot as noted above.

The effect will be to recursively produce a fragment tree and from it, a widget tree, caching these two so that they need not be recomputed at a later time (say, the next display cycle). 

This version of Hopscotch is reactive.

UI actions that result in semantic changes must invoke  #updateGUI: with a closure that takes the desired semantic action.

The call executes the closure and recomputes the state of the displayed fragment tree afresh based on the modified subjects (and their underlying models). This leads to update of the actual visual tree.

Other fragment trees (those tied to other presenters that are reachable via the UI) will be recomputed lazily when they are displayed.

The recomputation of fragments is ensured as follows: This class maintains a counter, #uiGeneration, which is incremented on every
call to #updateGUI:. When a presenter is created, it sets its #generation slot to the current value of #uiGeneration. When a subject is asked for its presenter and it has a cached presenter, it checks if the cached presenter's generation is less than #uiGeneration.
 If so, it creates a new presenter and updates its cache.

Most reactive frameworks endeavour to optimize this process to avoid excess recomputation of the visual tree. Typically this
involves a diff of the new and old fragment trees, to detect where changes have actually occurred and only rebuild the visuals of
the modified parts. In our case, such a diff is needed not only as an optimization, but to deal with stateful presenters or fragments.
For example, if a node in a tree-view (such as a method presenter) is open, we need to ensure that it remains open upon refresh. 
Likewise, if a node is being edited and the edit has not yet been saved, we must preserve the edited text.

In some systems, presenters are stateless, but this only moves the problem around. The above example remains necessary as a matter of good user experience; we can often move the state into the underlying application, but that state still needs to be managed. 

The diff process is driven by the #updateVisualsFrom: method of Fragment which accepts an old fragment to compare against. If fragments are not of the same kind, a new visual is computed and attached to the DOM at the right place.  To test whether fragments are of the same kind, they must implement #isMyKind:, which tests whether another fragment is of the same kind. The implementation is #isMyKind: is formulaic, calling #isKindOfX for whatever type X the presenter represents. 

If the incoming fragment parameter is of the same kind as the receiver,  #updateVisualsFrom: calls #updateFromSameKind: which Fragment subclasses must also implement. 

The method #updateFromSameKind:  is responsible for recomputing  the visual for the fragment, utilizing any relevant information from the old fragment. Typically this means preserving any state that should be retained across refreshes. Where possible, part or all of the original visual is reused. Using the visual returned by #updateFromSameKind:, #updateVisualsFrom: updates the cached visual of the fragment. 

In many cases, users of the framework can rely on the #updateFromSameKind: implementation of Presenter.  However, this is not always the case. In that case, one may have to override #updateFromSameKind:.

In some cases, the presenter needs to check if the old presenter is *relevant* before deciding to update. Typically this is done by testing if the subjects are equal. It may be that this test will move into the framework. If the old presenter is not relevant, #updateFromSameKind: should return the new visual. In that case, it must ensure that this visual replaces the old one by calling #replaceVisual:with: (again, maybe the framework can take care of this?).

In any case where the new visual is returned, one must never recursively call #updateFromSameKind:. This supports the invariant that #updateFromSameKind: is only called when the old visual's parent is valid.

If the user code has interesting state that requires deeper semantic understanding to preserve, the overriding #updateFromSameKind: method should ensure that any state that needs to be maintained, in either the old presenter or the old subject, is captured in the new presenter (respectively, the new subject).

Ensuring that all built-in fragments implement this protocol correctly, and applying it to the existing presenter classes of the web IDE is an ongoing process. So far, we have not seen a substantial performance problem (at least on desktops).  The main problems are preserving the state of presenters (the IDE presenters are mostly stateful for the reasons indicated above).

Moving forwards and backwards in the browser should display correctly updated views while preserving presenter state. Presenters
and subjects must be aware of the requirements imposed to support this requirement. See #SinglePageNavigationHistory and #NavigationHistory for a description.

See comments in Fragment, Presenter and Subject for more details.

Further documentation of subjects and decorators will be added in the future. *)
	
	(* Imports *)
	
	|
		private Color = p graphics Color.
		private Context = p graphics Context.
		private Point = p graphics Point.
		private Holder = ds Holder.
		private Font = p fonts Font.
		private FontConfig = p fonts FontConfig.
		private List = p collections List.
		private Map = p collections Map.
		private Set = p collections Set.
		private TextBlock = p text TextBlock.
		private TextProperties = p text TextProperties.
		private TextString = p text TextString.
		private Timer = p actors Timer.
		private MessageNotUnderstood = p kernel MessageNotUnderstood.
		private transcript = p transcript.
		
		(* re-export *)
		public VoiceController = VCC.
		
		(* AI integration. The chat UI classes (Subject and Presenter
       subclasses for the chat view, plus AIColors) live as sibling
       top-level classes in this module so they can read Subject and
       Presenter at enclosing scope. aiAccess is owned by the platform
       (no hopscotch dependency) and re-exported here; reading p
       aiAccess at slot-block time is safe because AIAccess's own
       slot block was reshaped to do only class-imports — its JS-side
       lookups are now lazy at AIAccess module body. *)
		public aiAccess = p aiAccess.
		private Session = aiAccess Session.
		
		(* JS and Web objects. These are initialized lazily because Hopscotch
   is provided by some Newspeak platforms. As such, the module is
   instantiated as part of the serialization process, before load time.
   Hence JS objects are not yet available. *)
		private js = p js.
		private document_slot
		
		(* Module variables (non-JS) *)
		currentHopscotchWindow <HopscotchShell>
		windowList <List[HopscotchShell]> = List new.
		uiGeneration <Number> ::= 0.
		private deferredContentQueue = List new.
		
		(* should be lazy *)
		
		(* Needs to be lazy because FontConfig precomputes maps.
   Maps rely on hash values, which are not stable across serialization.
And again, this module gets serialized as part of platform objects that
support the Newspeak GUI. *)
		public core = self.
		
		(* Polymorphic with HopscotchForBrazil *)
		public fragments = self.
		
		(* Polymorphic with HopscotchForBrazil *)
		public homeSubjectClass ::= HomeSubject.
		public useSurroundingNavigation <Boolean> ::= true.
		
		(* Re-export *)
		public ducts = ds.
		
		(* Images *)
		public images = is.
		
		(* Style *)
		public styleBorderColor <String> = 'silver'.
		public styleButtonSize <Float> = 30.
		public styleCheckboxSize = '36px'.
		public styleColorPickerSize = '36px'.
		public styleDefaultInset = '10px'.
		public styleDefaultInterfaceTextColor = '#3C3C3C'.
		public styleDefaultEditorTextColor = 'black'.
		public styleDefaultRadius = '5px'.
		public styleFontFamilyMonospace = 'ui-monospace, monospace'.
		public styleFontFamilySansSerif = '-apple-system, sans-serif'.
		public styleFontFamilySerif = 'serif'.
		public styleFontSizeEditor = '14px'.
		public styleFontSizeMenu = '13px'.
		public styleFontSizeText = '14px'.
		public styleMenuBackgroundColor = '#F6F6F6'.
		public styleMenuBorderColor = '#C7C7C7'.
		public styleMenuInset = '15px'.
		public styleMenuItemHeight = '24px'.
		public styleMenuShadowColor = 'darkgrey'.
		public styleRowHeight = '30px'.
		public styleTextInputHeight = '24px'.
		public styleZebraPrimaryColor = Color white.
		public styleZebraSecondaryColor = Color gray: 0.97.
	|
) (
	class BlankFragment new = LeafFragment new (
	) (
		createVisual = (
			^document createElement: 'div'
		)
		public isKindOfBlankFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfBlankFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			^oldFragment visual
		)
	) : ()
	class CheckboxFragment text: t <String> value: v <Boolean | Holder> action: a <[:Boolean | Object]> = LeafFragment new (
		|
			public text <String> ::= t.
			action <[:Boolean | Object]> = a.
			holder <Holder>
			public checked <Boolean>
			subscription <Block>
			checkbox <Alien[Element]>
		|
		v isKindOfHolder ifTrue: [
				holder:: v.
				checked:: holder value.
				subscription:: holder changed => [:value |
					checked:: value.
					checkbox at: 'checked' put: checked
				]
			]
			ifFalse: [ checked:: v ].
		('created checkbox with checked = ' , checked printString) out.
	) (
		public isKindOfCheckboxFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfCheckboxFragment
		)
		createVisual = (
			| container <Alien[Div]> = document createElement: 'div'. label <Alien[Element]> = document createTextNode: text. |
			container at: 'id' put: 'CheckboxContainer'.
			(container at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'row';
				at: 'align-items' put: 'center';
				at: 'justify-content' put: 'flex-start'.
			checkbox:: document createElement: 'input'.
			checkbox at: 'type' put: 'checkbox';
				at: 'checked' put: checked;
				at: 'onchange' put: inputHandler.
			container appendChild: checkbox.
			container appendChild: label.
			(checkbox at: 'style') at: 'min-width' put: styleCheckboxSize;
				at: 'min-height' put: styleCheckboxSize;
				at: 'margin-right' put: '5px'.
			^container
		)
		writeInput: v = (
			holder isNil ifFalse: [ holder value: v ].
			action isNil ifFalse: [ action value: v ]
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				checked:: checked not.
				writeInput: checked.
				checked
			]
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			text = oldFragment text ifFalse: [
					^replaceVisual: oldFragment visual with: visual
				].
			checkbox:: oldFragment visual.
			checked:: oldFragment checked.
			checkbox at: 'onchecked' put: inputHandler.
			^checkbox
		)
	) : ()
	class ColorPickerFragment value: v <String | Holder> action: a <[:String | Object]> = LeafFragment new (
		|
			action <[:String | Object]> = a.
			holder <Holder>
			color <String>
			subscription <Block>
			picker <Alien[Element]>
		|
		v isKindOfHolder ifTrue: [
				holder:: v.
				color:: holder value.
				subscription:: holder changed => [:value |
					color:: value.
					picker at: 'value' put: color
				]
			]
			ifFalse: [ color:: v ].
	) (
		public isKindOfColorPickerFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfColorPickerFragment
		)
		createVisual = (
			picker:: document createElement: 'input'.
			picker at: 'id' put: 'ColorPicker';
				at: 'type' put: 'color';
				at: 'value' put: color;
				at: 'oninput' put: inputHandler.
			(picker at: 'style') at: 'min-width' put: styleColorPickerSize;
				at: 'min-height' put: styleColorPickerSize;
				at: 'margin-right' put: '5px'.
			^picker
		)
		updateVisualsFromSameKind: oldFragment <ColorPickerFragment> ^<Alien[Element]> = (
			picker:: oldFragment visual.
			picker at: 'oninput' put: inputHandler.
			^picker
		)
		extractInput = (
			^color:: picker at: 'value'
		)
		writeInput: v = (
			holder isNil ifFalse: [ holder value: color ].
			action isNil ifFalse: [ action value: color ]
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				writeInput: extractInput.
				false
			]
		)
	) : ()
	class DatePickerFragment value: v <String | Holder> action: a <[:String | Object]> = LeafFragment new (
		|
			action <[:String | Object]> = a.
			holder <Holder>
			date <String>
			subscription <Block>
			picker <Alien[Element]>
		|
		v isKindOfHolder ifTrue: [
				holder:: v.
				date:: holder value.
				subscription:: holder changed => [:value |
					date:: value.
					picker at: 'value' put: date
				]
			]
			ifFalse: [ date:: v ].
	) (
		public isKindOfDatePickerFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfDatePickerFragment
		)
		createVisual = (
			picker:: document createElement: 'input'.
			picker at: 'id' put: 'DatePicker';
				at: 'type' put: 'date';
				at: 'value' put: date;
				at: 'oninput' put: inputHandler.
			^picker
		)
		updateVisualsFromSameKind: oldFragment <DatePickerFragment> ^<Alien[Element]> = (
			picker:: oldFragment visual.
			picker at: 'value' put: date;
				at: 'oninput' put: inputHandler.
			^picker
		)
		extractInput = (
			^date:: picker at: 'value'
		)
		writeInput: v = (
			holder isNil ifFalse: [ holder value: date ].
			action isNil ifFalse: [ action value: date ]
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				writeInput: extractInput.
				false
			]
		)
	) : ()
	class PickerFragment text: t <String> items: i <List[String]> action: a <[:String | Object]> = LeafFragment new (
		|
			text <String> ::= t.
			items <List[String]> = i.
			action <[:Boolean | Object]> = a.
			item <String>
			holder <Holder>
			subscription <Block>
			picker <Alien[Element]>
		|
	) (
		public isKindOfPickerFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfPickerFragment
		)
		createVisual = (
			| container <Alien[Div]> = document createElement: 'div'. label <Alien[Element]> = document createTextNode: text. option <Alien[Element]> |
			container at: 'id' put: 'PickerContainer'.
			(container at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'row';
				at: 'align-items' put: 'center';
				at: 'justify-content' put: 'flex-start'.
			container appendChild: label.
			picker:: document createElement: 'select'.
			(picker at: 'style') at: 'margin-left' put: '5px'.
			picker at: 'oninput' put: inputHandler.
			container appendChild: picker.
			items do: [:each |
					option:: document createElement: 'option'.
					option at: 'value' put: each;
						at: 'innerHTML' put: each.
					picker appendChild: option
				].
			^container
		)
		updateVisualsFromSameKind: oldFragment <PickerFragment> ^<Alien[Element]> = (
			(* Too much trouble to replace closures, text and items - might as well use new visual *)
			
			^replaceVisual: oldFragment visual with: visual
		)
		extractInput = (
			^item:: picker at: 'value'
		)
		writeInput: v = (
			holder isNil ifFalse: [ holder value: item ].
			action isNil ifFalse: [ action value: item ]
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				writeInput: extractInput.
				false
			]
		)
	) : ()
	class ProgressBarFragment value: v <Float | Holder> = LeafFragment new (
		|
			holder <Holder>
			percent <Float>
			public progress <Alien[Element]>
			subscription <Block>
		|
		v isKindOfHolder ifTrue: [
				holder:: v.
				percent:: holder value.
				subscription:: holder changed => [:value |
					percent:: value.
					progress at: 'value' put: percent
				]
			]
			ifFalse: [ percent:: v asFloat ].
	) (
		createVisual = (
			progress:: document createElement: 'progress'.
			progress at: 'value' put: percent.
			^progress
		)
		public isKindOfProgressBarFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfProgressBarFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| oldVisual = oldFragment visual. |
			progress:: oldFragment progress.
			^oldVisual
		)
	) : ()
	class RadioButtonFragment text: t <String> value: v <Boolean | Holder> group: g <String> action: a <[:Boolean | Object]> = LeafFragment new (
		|
			text <String> ::= t.
			group <String> = g.
			action <[:Boolean | Object]> = a.
			holder <Holder>
			checked <Boolean>
			subscription <Block>
			button <Alien[Element]>
		|
		v isKindOfHolder ifTrue: [
				holder:: v.
				checked:: holder value.
				subscription:: holder changed => [:value |
					checked:: value.
					button at: 'checked' put: checked
				]
			]
			ifFalse: [ checked:: v ].
	) (
		public isKindOfRadioButtonFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfRadioButtonFragment
		)
		createVisual = (
			| container <Alien[Div]> = document createElement: 'div'. label <Alien[Element]> = document createTextNode: text. |
			container at: 'id' put: 'RadioButtonContainer'.
			(container at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'row';
				at: 'align-items' put: 'center';
				at: 'justify-content' put: 'flex-start'.
			button:: document createElement: 'input'.
			button at: 'type' put: 'radio';
				at: 'checked' put: checked;
				at: 'name' put: group;
				at: 'oninput' put: inputHandler.
			container appendChild: button.
			container appendChild: label.
			(button at: 'style') at: 'min-width' put: styleCheckboxSize;
				at: 'min-height' put: styleCheckboxSize;
				at: 'margin-right' put: '5px'.
			^container
		)
		updateVisualsFromSameKind: oldFragment <RadioButtonFragment> ^<Alien[Element]> = (
			^replaceVisual: oldFragment visual with: visual
		)
		extractInput = (
			^checked:: checked not
		)
		writeInput: v = (
			holder isNil ifFalse: [ holder value: v ].
			action isNil ifFalse: [ action value: v ]
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				writeInput: extractInput.
				false
			]
		)
	) : ()
	class RectangleFragment new = BlankFragment new (
		|
			rectangle <Alien[Element]>
		|
		style backgroundColor: Color black.
	) (
		createVisual = (
			rectangle:: super createVisual.
			applyStyle: rectangle.
			(rectangle at: 'style') at: 'cursor' put: 'default'.
			registerGestures: rectangle.
			^rectangle
		)
		public isKindOfRectangleFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfRectangleFragment
		)
		public fill: color <Color> = (
			style backgroundColor: color
		)
		visualModified = (
			applyStyle: rectangle
		)
		updateVisualsFromSameKind: oldFragment <RectangleFragment> ^<Alien[Element]> = (
			^oldFragment visual
		)
	) : ()
	class SliderFragment value: v <Holder> min: mn <Float> max: mx <Float> = LeafFragment new (
		|
			holder <Holder> = v.
			min <Float> = mn.
			max <Float> = mx.
		|
	) (
		public isKindOfSliderFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfSliderFragment
		)
		createVisual = (
			| slider = document createElement: 'input'. |
			slider at: 'type' put: 'range';
				at: 'value' put: holder value;
				at: 'min' put: min;
				at: 'max' put: max;
				at: 'oninput' put: inputHandler.
			^slider
		)
		updateVisualsFromSameKind: oldFragment <SliderFragment> ^<Alien[Element]> = (
			| slider = oldFragment visual. |
			slider at: 'value' put: state getValue;
				at: 'min' put: min;
				at: 'max' put: max;
				at: 'oninput' put: inputHandler.
			^slider
		)
		extractInput = (
			^Float parse: (visual at: 'value')
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				writeInput: extractInput.
				false
			]
		)
		writeInput: v = (
			holder value: v
		)
	) : ()
	class Style new = Object new (
		|
			public backgroundColor <Color> ::= Color white.
			public foregroundColor <Color> ::= Color black.
			public borderType <String> ::= 'none'.
			public borderColor <Color> ::= Color white.
			public borderStyle <String> ::= 'solid'.
			public borderWidth <Float> ::= 0.
			public cornerRadius <Float> ::= 0.
			public hasFontInfo <Boolean> ::= false.
		|
	) (
	) : ()
	class ButtonStyle new = Style new (
		backgroundColor:: Color gray: 0.97.
		foregroundColor:: Color gray: 0.17.
		cornerRadius:: 5.
	) (
	) : ()
	class ButtonFragment label: l <String | HTMLFragment> action: a <[]> = LeafFragment new (
		|
			public label <String | HTMLFragment> = l.
			public enabled <Boolean> ::= true.
			action <[]> = a.
			style <ButtonStyle> = ButtonStyle new.
		|
	) (
		public isKindOfButtonFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfButtonFragment
		)
		setLabelContentOn: button <Alien[Element]> = (
			(* A button's label may be a plain String or an HTMLFragment. For an
   HTMLFragment, use its HTML as the button's contents - this lets a button
   carry rich (sized/coloured) text without a Hopscotch rich-text mechanism.
   Sending isKindOfHTMLFragment to a String safely answers false. *)
			
			label isKindOfHTMLFragment ifTrue: [ button at: #innerHTML put: label html ]
				ifFalse: [ button appendChild: (document createTextNode: label) ]
		)
		createVisual ^<Alien[HTMLButtonElement]> = (
			| button <Alien[HTMLButtonElement]> = document createElement: 'button'. |
			setLabelContentOn: button.
			button at: 'onclick'
				put: [:event <Alien[Event]> |
					action value.
					false
				];
				at: 'disabled' put: enabled not;
				at: 'contentEditable' put: 'false'.
			applyStyle: button.
			^button
		)
		updateVisualsFromSameKind: oldFragment <ButtonFragment> ^<Alien[HTMLButtonElement]> = (
			| oldVisual <Alien[HTMLButtonElement]> = oldFragment visual. |
			oldVisual at: 'onclick'
				put: [:event <Alien[Event]> |
					action value.
					false
				];
				at: 'disabled' put: enabled not.
			oldFragment label ~= label ifTrue: [
					oldVisual at: #innerHTML put: ''.
					setLabelContentOn: oldVisual
				].
			^oldVisual
		)
	) : ()
	class TimePickerFragment value: v <String | Holder> action: a <[:String | Object]> = LeafFragment new (
		|
			action <[:String | Object]> = a.
			holder <Holder>
			time <String>
			subscription <Block>
			picker <Alien[Element]>
		|
		v isKindOfHolder ifTrue: [
				holder:: v.
				time:: holder value.
				subscription:: holder changed => [:value |
					time:: value.
					picker at: 'value' put: time
				]
			]
			ifFalse: [ time:: v ].
	) (
		public isKindOfTimePickerFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTimePickerFragment
		)
		createVisual = (
			picker:: document createElement: 'input'.
			picker at: 'id' put: 'TimePicker';
				at: 'type' put: 'time';
				at: 'value' put: time;
				at: 'oninput' put: inputHandler.
			^picker
		)
		updateVisualsFromSameKind: oldFragment <TimePickerFragment> ^<Alien[Element]> = (
			picker:: oldFragment visual.
			picker at: 'value' put: time;
				at: 'oninput' put: inputHandler.
			^picker
		)
		extractInput = (
			^time:: picker at: 'value'
		)
		writeInput: v = (
			holder isNil ifFalse: [ holder value: time ].
			action isNil ifFalse: [ action value: time ]
		)
		inputHandler ^<[:Alien | Boolean]> = (
			^[:event |
				writeInput: extractInput.
				false
			]
		)
	) : ()
	class CallBackWrapper wrapping: h <[:T :S | Object]> = Object new (
		|
			public callback <[:T :S | Object]> ::= h.
		|
	) (
		public wrappedCallback = (
			^[:a1 :a2 | callback value: a1 value: a2 ]
		)
	) : ()
	class CanvasFragment withExtent: e = LeafFragment new (
		|
			private alien = document createElement: 'canvas'.
		|
		alien at: 'width' put: e x.
		alien at: 'height' put: e y.
		(alien at: 'style') at: 'position' put: 'relative'.
	) (
		public context = (
			^Context on: (alien getContext: '2d')
		)
		createVisual = (
			^alien
		)
		public isKindOfCanvasFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfCanvasFragment
		)
		public keyDownAction: onKeyPressed <[:String | Object]> = (
			(* The canvas element itself doesn't seem to get key events. *)
			
			body addEventListener: 'keydown'
				action: [:event |
					onKeyPressed value: (String fromCharCode: (event at: 'keyCode')).
					nil
				]
		)
		public mouseDownAction: onMouseDown <[:Point | Object]> = (
			alien addEventListener: 'mousedown'
				action: [:event |
					onMouseDown value: (event at: 'offsetX') @ (event at: 'offsetY').
					nil
				]
		)
		public mouseMovedAction: onMouseMoved <[:Point | Object]> = (
			alien addEventListener: 'mousemove'
				action: [:event |
					onMouseMoved value: (event at: 'offsetX') @ (event at: 'offsetY').
					nil
				]
		)
		updateVisualsFromSameKind: oldFragment <CanvasFragment> ^<Alien[Canvas]> = (
			^oldFragment visual
		)
	) : ()
	public class CodeMirrorFragment onText: t <String> = LeafFragment new (
		|
			public editor <Alien[CodeMirror]>
			
			(* IntersectionObserver that re-measures the editor whenever it
	   (re)enters the viewport — see createVisual. Held so it is not
	   collected. *)
			visibilityObserver <Alien>
			textSlot <TextFragment | String> ::= t.
			public useEditControls <Boolean> ::= true.
			public counterfactualBar <Alien[Span]>
			public messageContainer <Alien[Span]>
			public isInEditState ::= false.
			public changeResponse <[TextEditorFragment]>
			public acceptResponse <[TextEditorFragment]>
			public cancelResponse <[TextEditorFragment]>
			public evaluateResponse <[TextEditorFragment]>
			styles ::= List new.
			public beforeChangeHandler <CallBackWrapper>
			public changeHandler <CallBackWrapper>
			public keyHandler <CallBackWrapper>
			public beforeSelectionChangeHandler <CallBackWrapper>
			lastChangeWasSynthetic <Boolean> ::= false.
			public readOnly <Boolean> ::= false.
		|
	) (
		applyStyle: style <{Integer. Integer. Alien[JSObject]}> = (
			| s <Alien[CodeMirrorPosition]> e <Alien[CodeMirrorPosition]> |
			
			(* Newspeak intervals are 1-origin and [start, stop]. JS intervals are 0-origin and [start, stop). *)
			s:: editor posFromIndex: (style at: 1) - 1.
			e:: editor posFromIndex: (style at: 2).
			editor markText: s to: e style: (style at: 3)
		)
		applyStyles = (
			nil = editor ifFalse: [
					styles do: [:s <{Integer. Integer. Alien[JSObject]}> | applyStyle: s ].
					styles:: List new.
					editor refresh
				]
		)
		public defaultAcceptResponse = (
			textSlot:: editor getValue.
			leaveEditState
		)
		public defaultCancelResponse = (
			editor setValue: textSlot.
			leaveEditState
		)
		public defaultChangeResponse = (
			updateEditState
		)
		defaultStyle ^<Alien[Object]> = (
			| style <Alien[JSObject]> = JSObject new. |
			style at: 'css'
				put: 'color:' , styleDefaultEditorTextColor , ';' , 'font-family:' , styleFontFamilySerif , ';' , 'text-decoration: none; font-weight: normal'.
			^style
		)
		public isKindOfCodeMirrorFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfCodeMirrorFragment
		)
		public noticeExposure = (
			refresh
		)
		public refresh = (
			applyStyles
		)
		registerChangeHandler = (
			changeHandler:: CallBackWrapper wrapping: [:codeMirror :change |
					respondToChange: change.
					nil
				].
			editor on: 'change' respondToChange: changeHandler wrappedCallback
		)
		registerKeyHandler = (
			keyHandler:: CallBackWrapper wrapping: [:codeMirror :keydown |
					respondToKeyDown: codeMirror.
					nil
				].
			editor on: 'keydown' respondToKeyDown: keyHandler wrappedCallback
		)
		public resetStyles = (
			hasVisual ifFalse: [ ^self ].
			editor markText: (editor posFromIndex: 0)
				to: (editor posFromIndex: textBeingAccepted size - 1)
				style: defaultStyle
		)
		respondToAccept: event <Alien[Event]> = (
			nil = acceptResponse ifTrue: [ defaultAcceptResponse ]
				ifFalse: [ acceptResponse cull: self cull: event ]
		)
		respondToCancel = (
			(* confirm: 'Confirm Cancel' ifConfirmed:
		[ *)
			
			nil = cancelResponse ifTrue: [ defaultCancelResponse ]
				ifFalse: [ cancelResponse cull: self ]
			(* ] *)
			
		)
		respondToEvaluate = (
			nil = evaluateResponse ifFalse: [ evaluateResponse cull: self ]
		)
		respondToBeforeChange: event <Alien[Event]> = (
			updateEditState
		)
		respondToChange: change <Alien[CodeMirrorChangeObject]> = (
			nil = changeResponse ifTrue: [ defaultChangeResponse ]
				ifFalse: [ changeResponse cull: self cull: change ]
		)
		public style: style <Alien[JSObject]> from: start <Integer> to: end <Integer> = (
			styles add: {start. end. style. }.
			applyStyles
		)
		public text: t = (
			textSlot:: t.
			hasVisual ifTrue: [ editor setValue: t ]
		)
		public textBeingAccepted ^<String> = (
			^editor getValue
		)
		public removeMessages = (
			[ visual removeChild: messageContainer ] on: Error do: [:e | ]
		)
		public showMessage: message <String> = (
			messageContainer at: 'innerHTML' put: message.
			visual appendChild: messageContainer
		)
		public hasPendingChanges ^<Boolean> = (
			^isInEditState
		)
		public currentLine ^<String> = (
			^editor getLine: currentLineNumber
		)
		public showFragment: message <Fragment> = (
			messageContainer at: 'innerHTML' put: message.
			visual appendChild: messageContainer
		)
		public insert: fragment <Fragment> atLine: line <Integer> andColumn: column <Integer> = (
			| position = JSObject new. replaced = JSObject new. visual = fragment visual. |
			position at: 'line' put: line;
				at: 'ch' put: column.
			replaced at: 'replacedWith' put: visual;
				at: 'clearWhenEmpty' put: false.
			editor markText: position end: position replacedWith: replaced
		)
		public replace: withFragment <Fragment> = (
			| start = editor getCursor: 'from'. end = editor getCursor: 'to'. replaced = JSObject new. visual = withFragment visual. |
			replaced at: 'replacedWith' put: visual;
				at: 'clearWhenEmpty' put: false.
			editor markText: start end: end replacedWith: replaced.
			editor setCursor: end
		)
		public currentLineNumber ^<Integer> = (
			^editor getCursor at: #line
		)
		public currentColumnNumber ^<Integer> = (
			^editor getCursor at: #ch
		)
		public setWidth: w height: h = (
			editor setSize: w height: h
		)
		preventDefault: event <Alien> = (
			(* Designed as an overridable extension point, so we can choose not to actually call #preventDefault on event *)
			
			event preventDefault
		)
		cancelFromKeydown = (
			respondToCancel
		)
		respondToKeyDown: event <Alien[Event]> = (
			| key <Character> = event at: 'key'. metaPressed <Boolean> = 
			(* customary on mac, does not work on windows *)
			event at: 'metaKey'. ctrlPressed <Boolean> = 
			(* works on windows *)
			event at: 'ctrlKey'. shiftPressed <Boolean> = event at: 'shiftKey'. |
			(isInEditState and: [ useEditControls ]) ifTrue: [
					(metaPressed or: [ ctrlPressed ]) ifTrue: [
							key = 'Enter' ifTrue: [
									preventDefault: event.
									lastChangeWasSynthetic:: true.
									acceptFromKeydown: event.
									^self
								]
						].
					key = 'Escape' ifTrue: [
							preventDefault: event.
							lastChangeWasSynthetic:: true.
							cancelFromKeydown.
							^self
						]
				].
			shiftPressed ifTrue: [
					key = 'Enter' ifTrue: [
							preventDefault: event.
							lastChangeWasSynthetic:: true.
							respondToEvaluate.
							^self
						]
				]
		)
		registerBeforeChangeHandler = (
			beforeChangeHandler:: CallBackWrapper wrapping: [:codeMirror :change |
					
					(* No need to forward codeMirror - we have it already *)
					respondToBeforeChange: codeMirror.
					nil
				].
			editor on: 'beforeChange'
				respondToChange: beforeChangeHandler wrappedCallback
		)
		registerBeforeSelectionChangeHandler = (
			beforeSelectionChangeHandler:: CallBackWrapper wrapping: [:codeMirror :change |
					
					(* No need to forward codeMirror - we have it already *)
					respondToBeforeSelectionChange: change.
					nil
				].
			editor on: 'beforeSelectionChange'
				respondToChange: beforeSelectionChangeHandler wrappedCallback
		)
		respondToBeforeSelectionChange: event <Alien[Event]> = (
			(* Do nothing. Code mirror handles this for us *)
			
		)
		updateEditedText: oldFragment <CodeMirrorFragment> = (
			editor setValue: textSlot
		)
		updateVisualsFromSameKind: oldFragment <CodeMirrorFragment> ^<Alien[CodeMirror]> = (
			isInEditState:: oldFragment isInEditState.
			beforeChangeHandler:: oldFragment beforeChangeHandler.
			changeHandler:: oldFragment changeHandler.
			keyHandler:: oldFragment keyHandler.
			editor:: oldFragment editor.
			readOnly:: oldFragment readOnly.
			isInEditState ifTrue: [ textSlot:: oldFragment editor getValue ]
				ifFalse: [
					lastChangeWasSynthetic:: true.
					updateEditedText: oldFragment.
					oldFragment leaveEditState
				].
			useEditControls ifTrue: [
					counterfactualBar:: oldFragment counterfactualBar.
					(counterfactualBar at: 'firstChild') at: 'onclick'
						put: [:event |
							respondToAccept: event.
							nil
						].
					(counterfactualBar at: 'lastChild') at: 'onclick'
						put: [:event |
							respondToCancel.
							nil
						]
				].
			messageContainer:: oldFragment messageContainer.
			beforeChangeHandler callback: [:codeMirror :change |
					respondToBeforeChange: codeMirror.
					nil
				].
			changeHandler callback: [:codeMirror :change |
					respondToChange: change.
					nil
				].
			keyHandler callback: [:codeMirror :change |
					respondToKeyDown: codeMirror.
					nil
				].
			^oldFragment visual
		)
		acceptFromKeydown: event <Alien> = (
			(* and again *)
			
			respondToAccept: event
		)
		public updateEditState = (
			lastChangeWasSynthetic ifTrue: [
					lastChangeWasSynthetic:: false.
					^self
				].
			isInEditState ifFalse: [
					visual.
					useEditControls ifTrue: [
							(counterfactualBar at: 'style') at: 'opacity' put: '1.0';
								at: 'pointer-events' put: 'auto'
						].
					isInEditState:: true
				]
		)
		public leaveEditState = (
			isInEditState ifTrue: [
					useEditControls ifTrue: [
							(counterfactualBar at: 'style') at: 'opacity' put: '0.0';
								at: 'pointer-events' put: 'none'
						].
					removeMessages.
					isInEditState:: false
				]
		)
		createVisual = (
			| container <Alien[Div]> frame <Alien[Div]> accept <Alien[Img]> cancel <Alien[Img]> textArea <Alien[Span]> options <Alien[JSObject]> |
			container:: document createElement: 'div'.
			container at: 'id' put: 'CodeMirrorContainer'.
			(container at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'column';
				at: 'width' put: '99%';
				at: 'min-height' put: styleTextInputHeight;
				at: 'background-color' put: 'white';
				at: 'opacity' put: 1.0;
				at: 'border-style' put: 'solid';
				at: 'border-width' put: '1px';
				at: 'border-color' put: styleBorderColor.
			useEditControls ifTrue: [
					counterfactualBar:: document createElement: 'div'.
					(counterfactualBar at: 'style') at: 'display' put: 'flex';
						at: 'flex-direction' put: 'row';
						at: 'align-items' put: 'center';
						at: 'justify-content' put: 'flex-end';
						at: 'z-index' put: '10';
						at: 'opacity' put: '0.0';
						at: 'width' put: 'auto';
						at: 'pointer-events' put: 'none'.
					accept:: document createElement: 'img'.
					accept at: 'src' put: (accept16px yourself at: 'src').
					(accept at: 'style') at: 'width' put: '22px'.
					accept at: 'onclick'
						put: [:event |
							respondToAccept: event.
							nil
						].
					counterfactualBar appendChild: accept.
					cancel:: document createElement: 'img'.
					cancel at: 'src' put: (cancel16px yourself at: 'src').
					(cancel at: 'style') at: 'width' put: '22px'.
					cancel at: 'onclick'
						put: [:event |
							respondToCancel.
							nil
						].
					counterfactualBar appendChild: cancel
				].
			frame:: document createElement: 'div'.
			frame at: 'id' put: 'CodeMirrorFragment'.
			(frame at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'row'.
			container appendChild: frame.
			useEditControls ifTrue: [ container appendChild: counterfactualBar ].
			textArea:: document createElement: 'textarea'.
			textArea at: 'value' put: textSlot;
				at: 'resize' put: true.
			frame appendChild: textArea.
			options:: JSObject new.
			options at: 'lineWrapping' put: true.
			options at: 'readOnly' put: readOnly.
			options at: 'scrollbarStyle' put: 'null'.
			options at: 'autoRefresh' put: true.
			editor:: CodeMirror fromTextArea: textArea with: options.
			
			(* Persistent repaint-on-visible. CodeMirror caches a viewport and
	   will not paint while its DOM is detached or zero-size; the
	   autoRefresh addon fires only once at first display, so an editor
	   that is detached and later reattached (a document reused across
	   navigation, a transcluded copy, a collapsed pane) stays painted
	   stale until clicked. Observe the wrapper and refresh whenever it
	   (re)enters the viewport. IntersectionObserver delivers its callback
	   after layout, so the editor is genuinely visible when we refresh.
	   This only re-measures/repaints — it never touches the document, so
	   any unaccepted edits are preserved. *)
			[
				visibilityObserver:: (window at: 'IntersectionObserver') new: [:entries :observer |
						
						(* Refresh on any callback. We observe a single element, so a
		   callback means its visibility changed; refreshing when it just
		   became hidden is a harmless no-op, and refreshing when it became
		   visible is the whole point. Guarded so a torn-down editor can't
		   crash the async callback. *)
						[ editor isNil ifFalse: [ editor refresh ] ] on: Exception do: [:e | nil ].
						nil
					].
				visibilityObserver observe: editor getWrapperElement
			] on: Exception do: [:e | nil ].
			registerBeforeChangeHandler.
			registerChangeHandler.
			registerKeyHandler.
			registerBeforeSelectionChangeHandler.
			((textArea at: 'nextSibling') at: 'style') at: 'height' put: 'unset';
				at: 'width' put: '100%';
				at: 'background-color' put: 'transparent';
				at: 'fontFamily' put: styleFontFamilySerif;
				at: 'font-size' put: styleFontSizeEditor.
			messageContainer:: document createElement: 'div'.
			(messageContainer at: 'style') at: 'background-color' put: '#FFE6B3';
				at: 'border-top' put: '1px solid silver';
				at: 'display' put: 'flex';
				at: 'flex-direction' put: 'row';
				at: 'align-items' put: 'left';
				at: 'vertical-align' put: 'middle';
				at: 'padding-left' put: styleDefaultInset;
				at: 'width' put: '100%';
				at: 'height' put: '20px'.
			^container
		)
	) : ()
	class ColorDecorator color: c <Color> = Decorator new (
		|
			color <Color> = c.
		|
	) (
		public decorate: aVisual = (
			color applyToStyle: (aVisual at: 'style').
			^aVisual
		)
	) : ()
	class ColumnComposer definitions: fs <List[Fragment]> = SequenceComposer definitions: fs (
		crossAxisStretch.
	) (
		flexDirection ^<String> = (
			^'column'
		)
		public isKindOfColumnComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfColumnComposer
		)
	) : ()
	class Composer new = Fragment new (
	) (
	) : ()
	public class Decorator new = Object new (
		(* A Decorator is attached to a fragment and is called by the fragment to change the various attributes of the Brazil visual created by the fragment itself. *)
		
	) (
		public decorate: aVisual = (
			(* Change properties of aVisual or wrap it into a new visual that applies whatever decorating we represent to aVisual. Answer aVisual or the new visual. *)
			
			subclassResponsibility
		)
	) : ()
	class DeferredContentComposer initialContent: ic contentSource: cs = Composer new (
		|
			initialContent <Fragment> = ic.
			contentSource <[Fragment]> = cs.
			contentFragment <Fragment>
		|
	) (
		public childrenDo: aBlock = (
			nil = contentFragment ifFalse: [ aBlock value: contentFragment ]
				ifTrue: [ aBlock value: initialContent ]
		)
		createVisual = (
			| div initialVisual |
			div:: document createElement: 'div'.
			div at: 'id' put: 'DeferredContentComposer'.
			(div at: 'style') at: 'align-self' put: 'center'.
			initialVisual:: initialContent visual.
			div appendChild: initialVisual.
			deferAction: [
					| deferredFragment = contentSource value. |
					deferredFragment parent: self.
					contentFragment:: deferredFragment.
					
					(* replace: new with: old due to stupid DOM argument ordering *)
					div replaceChild: deferredFragment visual with: initialVisual
				].
			^div
		)
		public isKindOfDeferredContentComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfDeferredContentComposer
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| oldVisual = oldFragment visual. |
			deferAction: [
					| deferredFragment = contentSource value. |
					deferredFragment parent: self.
					contentFragment:: deferredFragment.
					
					(* replace: new with: old due to stupid DOM argument ordering *)
					oldVisual replaceChild: deferredFragment visual
						replacing: (oldVisual at: 'firstChild')
				].
			^oldVisual
		)
	) : ()
	class AsyncContentComposer initially: ic producer: pr = Composer new (
		(* Like DeferredContentComposer, but the replacement content arrives
   asynchronously. `producer` is a closure that takes a one-argument `fill`
   callback; it starts its async work and, when the content is ready (possibly
   several turns later), invokes `fill value: aFragment`. We then swap the
   initial placeholder's visual for the new fragment's, reusing the same DOM
   surgery DeferredContentComposer performs. A plain fragment - no
   subject/presenter pair. *)
		
		|
			initialContent <Fragment> = ic.
			producer <[:Object | Object]> = pr.
			public contentFragment <Fragment>
			public holderVisual
			public shownVisual
			public started ::= false.
		|
	) (
		public childrenDo: aBlock = (
			nil = contentFragment ifFalse: [ aBlock value: contentFragment ]
				ifTrue: [ aBlock value: initialContent ]
		)
		createVisual = (
			holderVisual:: document createElement: 'div'.
			shownVisual:: initialContent visual.
			holderVisual appendChild: shownVisual.
			ensureStarted.
			^holderVisual
		)
		ensureStarted = (
			started ifFalse: [
					started:: true.
					producer value: [:frag <Fragment> | fillWith: frag ]
				]
		)
		fillWith: aFragment <Fragment> = (
			| newVisual |
			aFragment parent: self.
			contentFragment:: aFragment.
			nil = holderVisual ifFalse: [
					newVisual:: aFragment visual.
					
					(* replace: new with: old due to stupid DOM argument ordering *)
					holderVisual replaceChild: newVisual with: shownVisual.
					shownVisual:: newVisual.
					aFragment noticeExposure
				]
		)
		public isKindOfAsyncContentComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfAsyncContentComposer
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			(* Adopt the prior instance's live DOM and state so any in-flight fill
     lands in the visible tree and already-resolved content is preserved. The
     prior instance's fill closure targets its own holderVisual, which we reuse
     here, so the swap still reaches the DOM node on screen. *)
			
			holderVisual:: oldFragment holderVisual.
			shownVisual:: oldFragment shownVisual.
			contentFragment:: oldFragment contentFragment.
			started:: oldFragment started.
			^holderVisual
		)
	) : ()
	class NavBarFragment items: navItemList content: liveContent = Composer new (
		(* A deploy-aware navigation bar: renders `content` (a row of nav buttons)
     live, and carries `items` (a list of {label. target. external} tuples) so
     the web-deploy can emit static <a> links. See Document>>navBar:. *)

		|
			public navItems <List> = navItemList.
			content <Fragment> = liveContent.
		|
	) (
		public childrenDo: aBlock = (
			aBlock value: content
		)
		createVisual = (
			^content visual
		)
		public isKindOfNavBarFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfNavBarFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			^oldFragment visual
		)
	) : ()
	class WebTransclusionFragment transcluding: cn content: liveContent lazily: lz titled: ttl = Composer new (
		(* A deploy-aware transclusion. Renders `content` live (a toggle for a lazy
     transclusion, an inline transclude for an eager one), and carries the
     transcluded document name + lazy flag + title so the web-deploy can emit a
     link (lazy) or inline the child (eager). See Document>>webTransclusion:.
     Rendering is delegated to `content`, so the live toggle behaves normally. *)

		|
			public transcludedDocName <String> = cn.
			public lazyTransclusion <Boolean> = lz.
			public transclusionTitle <String> = ttl.
			public content <Fragment> = liveContent.
		|
	) (
		public childrenDo: aBlock = (
			aBlock value: content
		)
		createVisual = (
			content parent: self.
			^content visual
		)
		public isKindOfWebTransclusionFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfWebTransclusionFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			(* Delegate reconciliation to the wrapped (possibly dynamic) content. *)
			content updateVisualsFrom: oldFragment content.
			^content visual
		)
	) : ()
	class DropDownMenuFragment menu: ms image: img <Image> alignment: side <Symbol> = ImageButtonFragment new (
		(* Create a drop down menu based on dynamic content. This means that the menu contents may vary every time the menu button
is clicked.  The contents are computed by a closure provided by the ms argument to the factory, and stored in the
menuSupplier slot.  The image to use for the menu button is provided by the img argument.  Menus may be aligned to the right
or the left; ideally, the system would figure the best alignment dynamically, but for now it must be specified via the side argument. Usually the presenter has a good idea what side the menu should be aligned to, so this is not a high priority item to address.

Class methods that provide convenient defaults for the button image and the alignment are provided as well. *)
		
		|
			menuSupplier <[{Symbol | {String. [Object]}}]> = ms.
			
			(* Skip formal menu structure for now *)
			alignment <String> = side asString.
			image = img.
			action = [ ].
			width = styleButtonSize.
			height = styleButtonSize.
			public clickHandler = computeClickHandler.
		|
	) (
		public isKindOfDropDownMenuFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfDropDownMenuFragment
		)
		createVisual ^<Alien[Element]> = (
			| menu = super createVisual. |
			menu addEventListener: 'click' action: clickHandler.
			(menu at: 'style') at: 'cursor' put: 'pointer'.
			image addEventListener: 'mousedown'
				action: [:event |
					(image at: 'style') at: 'filter' put: 'brightness(130%)'.
					nil
				];
				addEventListener: 'mouseover'
					action: [:event |
						(image at: 'style') at: 'filter' put: 'brightness(50%)'.
						nil
					];
				addEventListener: 'mouseout'
					action: [:event |
						(image at: 'style') at: 'filter' put: ''.
						nil
					].
			^menu
		)
		updateContent ^<Alien[Element]> = (
			| menu <Alien[Div]> = computeContentForMenu: menuSupplier. |
			showMenu: menu forFragment: self.
			^menu
		)
		public removeContentFromShell: s = (
			s activeMenuBlurred
		)
		computeClickHandler = (
			^[:event |
				updateContent.
				nil
			]
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			^replaceVisual: oldFragment visual with: visual
			(* | oldVisual = oldFragment visual. img = oldVisual at: 'firstChild'.|
    img at: 'onclick' put: [:event | action value. false].
    oldVisual 
       removeEventListener: 'click' listener: oldFragment clickHandler ;
       addEventListener: 'click' action: clickHandler.
   ^oldVisual *)
			
		)
	) : (
		public menu: ms <[{Symbol | {String. [Object]}}]> ^<Instance> = (
			^menu: ms image: dropDownImage alignment: #right
		)
		public menu: ms <[{Symbol | {String. [Object]}}]> alignment: side <Symbol> ^<Instance> = (
			^menu: ms image: dropDownImage alignment: side
		)
		public menu: ms <[{Symbol | {String. [Object]}}]> image: img <Image> ^<Instance> = (
			^menu: ms image: img alignment: #right
		)
	)
	public class EmbeddedHopscotchWindow into: container openSubject: s = HopscotchWindow into: container
		openSubject: s (
		(* Hopscotch windows can be embedded within web pages, rather than representing the entire page. In this situation,
    there can be multiple windows in a given page. This class represents such windows.

    Each such window maintains its own navigation history.
   
    Browser forward/back actions trigger the popState event in the browser. We set up a closure, sharedBackButtonListener,
    to be triggered on the popState event. It acts on the information in windowStack as described above. See the listenForBackButton
    method for the relevant code. *)
		
	) (
		class ToolbarPresenter new = super ToolbarPresenter new (
		) (
			backButton = (
				^imageButton: backImage action: [ goBack ] size: styleButtonSize
			)
			forwardButton = (
				^imageButton: forwardImage action: [ goForward ] size: styleButtonSize
			)
			futureButton = (
				^imageButton: dropDownImage
					action: [ selectFromFuture ]
					size: styleButtonSize
			)
			pastButton = (
				^imageButton: dropDownImage action: [ selectFromPast ] size: styleButtonSize
			)
			selectFromPast = (
				| menuItems = List new. |
				outer EmbeddedHopscotchWindow navigator past reverse keysAndValuesDo: [:index :each |
						| item |
						item:: {each title. [ selectPastIndex: index ]. }.
						menuItems add: item
					].
				openMenuWithLabelsAndActions: menuItems
			)
			selectFromFuture = (
				| menuItems = List new. |
				outer EmbeddedHopscotchWindow navigator future keysAndValuesDo: [:index :each |
						| item |
						item:: {each title. [ selectFutureIndex: index ]. }.
						menuItems add: item
					].
				openMenuWithLabelsAndActions: menuItems
			)
			toolbarItems ^<Array[Fragment]> = (
				^{pastButton. backButton. forwardButton. futureButton. mediumBlank. } , super toolbarItems
			)
		) : ()
		public isKindOfEmbeddedHopscotchWindow = (
			^true
		)
		selectFutureItem: aPresenter = (
			navigator goToFutureItem: aPresenter.
			displayPresenter: navigator current
		)
		selectPastItem: aPresenter = (
			navigator goToPastItem: aPresenter.
			displayPresenter: navigator current
		)
		setTitle: t = (
			(* Not a full-page app: don't update document title. *)
			
		)
		public enterSubject: s <Subject> fromSnippet: snippet <SnippetSubject> = (
			enterSubject: s
		)
		navigationHistory = (
			^MultiPageNavigationHistory new
		)
		selectPastIndex: i <Integer> = (
			navigator goToPastIndex: i.
			displayPresenter: navigator current
		)
		selectFutureIndex: i <Integer> = (
			navigator goToFutureIndex: i.
			displayPresenter: navigator current
		)
		listenForBackButton = (
			(* do nothing *)
			
		)
		public goForward = (
			currentHopscotchWindow:: self.
			super goForward
		)
		public goBack = (
			currentHopscotchWindow:: self.
			super goBack
		)
	) : (
		public openSubject: s = (
			^into: body openSubject: s
		)
	)
	public class FileChooserFragment allowMultiples: b <Boolean> = Fragment new (
		|
			public allowMultiples <Boolean> = b.
		|
	) (
		public chooseFileList: blk <[:List[Alien[File]] | Object]> = (
			| fileList <Alien[FileList]> result <List> = List new. node = input. |
			node addEventListener: 'change'
				action: [:event |
					fileList:: node at: 'files'.
					fileList isUndefined ifFalse: [
							0 to: (fileList at: 'length') - 1
								do: [:i <Integer> | result add: (fileList at: i) ].
							blk value: result.
							nil
						]
				].
			node click
		)
		public chooseSingleFile: blk <[:Alien[File] | Object]> = (
			allowMultiples ifTrue: [
					Error signal: 'This chooser may choose multiple files'
				].
			chooseFileList: [:files <List[Alien[File]]> | blk value: (files at: 1) ]
		)
		public chooseFileList: blk <[:List[Alien[File]] | Object]> ifCanceled: cancelBlk <[Object]> = (
			(* Like chooseFileList:, but also wires the input's 'cancel' event so the
     caller learns when the user dismisses the dialog without picking. The
     browser fires 'cancel' on <input type=file> when the dialog is closed
     with no selection (Chrome 113+, Firefox 91+, Safari 16.4+); on older
     engines the cancel callback simply never fires. *)
			
			| fileList <Alien[FileList]> result <List> = List new. node = input. |
			node addEventListener: 'change'
				action: [:event |
					fileList:: node at: 'files'.
					fileList isUndefined ifFalse: [
							0 to: (fileList at: 'length') - 1
								do: [:i <Integer> | result add: (fileList at: i) ].
							blk value: result.
							nil
						]
				].
			node addEventListener: 'cancel'
				action: [:event |
					cancelBlk value.
					nil
				].
			node click
		)
		public chooseSingleFile: blk <[:Alien[File] | Object]> ifCanceled: cancelBlk <[Object]> = (
			allowMultiples ifTrue: [
					Error signal: 'This chooser may choose multiple files'
				].
			chooseFileList: [:files <List[Alien[File]]> | blk value: (files at: 1) ]
				ifCanceled: cancelBlk
		)
		createVisual = (
			| v <Visual> = document createElement: 'input'. |
			(v at: 'style') at: 'display' put: 'none'.
			v at: 'type' put: 'file';
				at: 'multiple' put: allowMultiples;
				at: 'id'
					put: 'newspeakFileChooser_allowMultiples = ' , allowMultiples printString.
			^v
		)
		input ^<Alien[Input]> = (
			hasVisual ifFalse: [ ^createVisual ].
			^visual
		)
		public isKindOfFileChooserFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfFileChooserFragment
		)
	) : (
		public new ^<Instance> = (
			^allowMultiples: false
		)
	)
	public class Fragment new = Object new (
		(* The root of the hierarchy for logical UI tree nodes.

Subclasses that embed subtrees must ensure that they update the parent link of the subtree when creating a visual
or manipulating it (i.e., via updateVisualsFrom:).

Fragments must implement #isMyKind:, which tests whether another fragment is of the same kind. The implementation is #isMyKind: is formulaic, calling #isKindOfX for whatever type X the presenter represents.

They must also implement #createVisual, which is used to create the concrete widget tree representing this fragment.

Another subclass responsibility is #updateVisualsFromSameKind:, which updates the fragment's visuals based on a
(presumably older) fragment of the same kind.

A further subclass responsibility is #childrenDo:, which iterates the fragment's logical child fragments. The framework's tree-propagation methods (#refresh, #noticeExposure, #hasPendingChanges) walk the hierarchy by sending #childrenDo: to each node. Leaf fragments implement it as an empty method; composite fragments yield each child in order. *)
		
		|
			visualX
			public parent
			public size ::= nil.
			public expansibility ::= 0.
			public compressibility ::= 0.
			decorators
			toolTip_slot <String> ::= ''.
		|
	) (
		public isKindOfFragment ^<Boolean> = (
			^true
		)
		public addDecorator: newDecorator <Decorator> = (
			(* The argument is added last to the collection of our decorators, meaning it will be applied after all the other decorators we might have. *)
			
			nil = decorators ifTrue: [ decorators:: List new ].
			decorators addLast: newDecorator
		)
		createVisual = (
			subclassResponsibility
		)
		public childrenDo: aBlock <[:Fragment | Object]> = (
			(* Iterate the receiver's logical child fragments in order. Called
	   by the framework's tree-propagation methods (#refresh,
	   #noticeExposure, #hasPendingChanges) to walk the hierarchy. Leaf
	   fragments override to no-op; composite fragments override to
	   yield each child. *)
			
			subclassResponsibility
		)
		public decorate: aVisual = (
			(* The argument is a visual freshly created by the #createVisual or #createViewportWithVisual method. If we have any decorators attached, apply them now to arrive at the final decorated visual. *)
			
			| decorated |
			decorated:: aVisual.
			nil = decorators ifFalse: [
					decorators do: [:each | decorated:: each decorate: decorated ]
				].
			^decorated
		)
		public elasticity: x = (
			expansibility: x.
			compressibility: x
		)
		public hasPendingChanges ^<Boolean> = (
			(* Answer whether the fragment at this time displays any changes made by the user which haven't yet been applied to the displayed objects (for example, method edits). *)
			
			childrenDo: [:any | any hasPendingChanges ifTrue: [ ^true ] ].
			^false
		)
		public hasVisual = (
			^visualX isNil not
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			(* Every fragment type X needs to have an implementation of this that amounts to:
    isMyKind: f <Fragment> ^ <Boolean> = (
      ^f isKindOfX
   )

along with an implementation of isKindOfX:  public isKindOfX ^ <Boolean> = (true) *)
			
			subclassResponsibility
		)
		public refresh = (
			(* Fragments that dynamically retrieve their information should reimplement this to update their visuals accordingly. *)
			
			childrenDo: [:each | each refresh ]
		)
		public replaceVisual: oldVisual <Alien[Element]> with: newVisual <Alien[Element]> = (
			| oldParent <Alien[Node]> = oldVisual at: 'parentNode'. |
			oldParent isNil ifFalse: [
					oldParent replaceChild: newVisual replacing: oldVisual
				].
			^newVisual
		)
		public shell = (
			^parent isNil ifTrue: [
					Error signal: 'hierarchy not installed in a shell :' , printString
				]
				ifFalse: [ parent shell ]
		)
		updateGUI: action <[Object]> = (
			(* Must be called whenever a semantic change (a change to either the underlying model, or the subject state).
    The action parameter is a closure that will cause the desired semantic change. *)
			
			updateAllWindows: action.
			^nil
		)
		public updateVisualsFrom: oldFragment <Fragment> = (
			(isMyKind: oldFragment) ifTrue: [
					visualX:: oldFragment hasVisual ifTrue: [
							updateVisualsFromSameKind: oldFragment
						]
				]
				ifFalse: [ replaceVisual: oldFragment visual with: visual ]
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			(* This method must never be called unless oldFragment hasVisual = true 
Returns the updated  visual of the fragment,  cognizant of data in
oldFragment.  Any state that the fragment maintains should be preserved in the new visual.
The visual returned will often be oldFragment's visual, patched to be up to date as needed.
In other cases, the new visual is computed, but updated to reflect state from olfFragment. *)
			
			subclassResponsibility
		)
		public value = (
			^self
		)
		public sendUp ^<RequestDispatcher> = (
			(* Create and answer a RequestDispatcher that can deliver a request on behalf of the receiver. *)
			
			^UpwardRequestDispatcher sender: self
		)
		public sendDown ^<DownwardRequestDispatcher> = (
			(* Create and answer a RequestDispatcher that can deliver a downward request on behalf of the receiver. *)
			
			^DownwardRequestDispatcher sender: self
		)
		public receiveRequestFrom: dispatcher <RequestDispatcher> ^<Boolean> = (
			(* Process the request to execute a 'vertical' message carrried by the dispatcher and answer true, or answer false if the request is not recognized. *)
			
			^false
		)
		public noticeExposure = (
			(* Propagated down the fragment hierarchy just after the hierarchy has been made visible. A fragment may receive this message multiple times over its life. Used by certain leaf fragments, such as CodeMirrorFragment, who may need to explicitly refresh themselves upon exposure as they have no direct connection to changed subjects. *)
			
			childrenDo: [:each | each noticeExposure ]
		)
		removeChild: c <Alien[Element]> fromVisual: v <Alien[Element]> = (
			| children = v at: #children. |
			0 to: (children at: #length)
				do: [:i | c = (v at: #i) ifTrue: [ v removeChild: c ] ]
		)
		updateToolTip = (
			hasVisual ifTrue: [ visual setAttribute: #title to: toolTip_slot ]
		)
		public visual = (
			visualX isNil ifTrue: [
					visualX:: decorate: createVisual.
					updateToolTip
				].
			^visualX
		)
		public toolTip: s <String> = (
			toolTip_slot:: s.
			updateToolTip
		)
		public width: w elasticity: e = (
			size: w.
			elasticity: e
		)
	) : ()
	public class Gradient from: a to: b = Object new (
		|
			topColor = a.
			bottomColor = b.
		|
	) (
		public applyToStyle: style = (
			| value |
			value:: '(top,' , topColor asCSSString , ',' , bottomColor asCSSString , ')'.
			style setProperty: 'background-image' to: '-webkit-linear-gradient' , value.
			style setProperty: 'background-image' to: '-moz-linear-gradient' , value
		)
	) : ()
	class HistoryPresenter onSubject: s = Presenter onSubject: s (
	) (
		forgetAll = (
			shell eraseHistory
		)
		forgetEntry: aPresenter = (
			shell eraseHistoryEntry: aPresenter
		)
		public isKindOfHistoryPresenter ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfHistoryPresenter
		)
		public isTransient ^<Boolean> = (
			(* Should not be recorded in navigation history. *)
			
			^true
		)
		majorHeadingBlock: body = (
			^(padded: body with: {10. 10. 5. 10. }) color: majorHeadingColor
		)
		majorHeadingColor = (
			^Gradient from: (Color h: 240 s: 0.05 v: 0.92)
				to: (Color h: 240 s: 0.05 v: 0.86)
		)
		presentersForHistoryEntries ^<Collection[Presenter]> = (
			| presenters |
			presenters:: List new: 20.
			subject historyDo: [:each |
					presenters add: (row: {elastic: each listElementMetapresenter. blank: 5. forgetEntryUIFor: each. blank: 5. })
				].
			^presenters
		)
		forgetAllButton = (
			^button: 'Forget All' action: [ updateGUI: [ forgetAll ] ]
		)
		helpText = (
			| mapping = Map new. |
			mapping at: #hopscotchForgetAllButton put: forgetAll;
				at: #hopscotchHelpButton put: helpButton.
			^ampleforth: 'This is a history results presenter.  Click on any link on the page to go to that location. You''ll find it just as you left it - with subpanes open, unaccepted edits still preserved etc. This means you can leave any view to go to another, regardless of its state. Interaction with the browser is modeless. It also means that you are never more than two clicks away from any place you''ve browsed - one click to the history, and one click from there to any prior destination.
  <br><br>
  To the right of each link is a cancelation button, which removes that link from the history. This can be useful to prevent clutter building up.
  <ul>
      <li>div class="hopscotchForgetAllButton"> </div> Erases the entire history.</li>
      <li><div class="hopscotchHelpButton"> </div> Shows this help message.</li>
   </ul> <br>'
				mapping: mapping
		)
		definition = (
			^column: {majorHeadingBlock: (row: {(label: 'Viewed in this Browser') bold. filler. button: 'Forget All'
							action: [ updateGUI: [ forgetAll ] ]. }). blank: 2. zebra: (column: presentersForHistoryEntries). }
		)
		forgetEntryUIFor: aPresenter = (
			^(imageButton: clearImage
				action: [ updateGUI: [ forgetEntry: aPresenter ] ]
				size: styleButtonSize) toolTip: 'Forget this item'
		)
	) : ()
	public class HistorySubject onModel: m = Subject onModel: m (
	) (
		public createPresenter = (
			^HistoryPresenter onSubject: self
		)
		public historyDo: aBlock = (
			(* Evaluate the argument for all presenters in the history I represent, most recently visited one first. *)
			
			^model allVisits reverse do: aBlock
		)
		public isKindOfHistorySubject ^<Boolean> = (
			^true
		)
		isMyKind: other = (
			^other isKindOfHistorySubject
		)
		public title = (
			^'History'
		)
	) : ()
	class HolderComposer withContent: definition <Fragment | [Fragment]> = Composer new (
		|
			contentSource <Fragment | [Fragment]> ::= definition.
			actualContent <Fragment>
		|
	) (
		public childrenDo: aBlock <[:Fragment | Object]> = (
			nil = actualContent ifFalse: [ aBlock value: actualContent ]
		)
		public content ^<Fragment> = (
			nil = actualContent ifTrue: [
					actualContent:: contentSource value.
					actualContent parent: self
				].
			^actualContent
		)
		createVisual = (
			| div |
			div:: document createElement: 'div'.
			div at: 'id' put: 'HolderComposer'.
			div appendChild: content visual.
			^div
		)
		public isKindOfHolderComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfHolderComposer
		)
		public noticeExposure = (
			refresh
		)
		public content: fragment = (
			fragment parent: self.
			hasVisual ifTrue: [
					actualContent:: fragment.
					
					(* replace: new with: old due to stupid DOM argument ordering *)
					visual replaceChild: actualContent visual
						insteadOf: (visual at: 'firstChild').
					assert: [ actualContent visual contains: (visual at: 'firstChild') ]
						message: 'holder invariant broken2'
				]
				ifFalse: [ contentSource:: actualContent:: fragment ]
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			content updateVisualsFrom: oldFragment content.
			^oldFragment visual
		)
		public refresh = (
			(contentSource isKindOfClosure and: [ hasVisual ]) ifTrue: [
					| oldContent newContent |
					oldContent:: actualContent.
					actualContent:: nil.
					newContent:: content.
					
					(* replace: new with: old due to stupid DOM argument ordering *)
					visual replaceChild: newContent visual with: oldContent visual
				]
				ifFalse: [ actualContent isNil ifFalse: [ actualContent refresh ] ]
		)
	) : ()
	class HomePresenter onSubject: s = Presenter onSubject: s (
	) (
		public definition = (
			^label: 'Home'
		)
		isMyKind: s <Subject> ^<Boolean> = (
			^s isKindOfHomePresenter
		)
		public isKindOfHomePresenter ^<Boolean> = (
			^true
		)
	) : (
		public new ^<Instance> = (
			^onSubject: HomeSubject new
		)
	)
	public class HomeSubject new = Subject onModel: nil (
	) (
		public createPresenter = (
			^HomePresenter onSubject: self
		)
		public isKindOfHomeSubject ^<Boolean> = (
			^true
		)
		isMyKind: s <Subject> ^<Boolean> = (
			^s isKindOfHomeSubject
		)
	) : ()
	class HopscotchShell new
	(* :exemplar: fail *)
	 = Object new (
		(* The abstract superclass of Hopscotch wndows. We deliberately set the exemplar to fail, because no instance of this class should exist. The factory adds self to the window list, but such a window is malformed unless self is an instance of a subclass of this class. To avoid corrupting the UI, we must not create instances of this class itself - only of valid subclasses. *)
		
		|
			navigator = navigationHistory.
			currentPresenterX
			toolbarHolder = document createElement: 'div'.
			contentHolder = document createElement: 'div'.
			public activeMenu <Alien[Div]>
			public activeMenuParent <Alien[Node]>
		|
		toolbarHolder at: 'id' put: 'HopscotchShellToolbarHolder'.
		contentHolder at: 'id' put: 'HopscotchShellContentHolder'.
		windowList add: self.
	) (
		atHome ^<Boolean> = (
			^currentPresenter isKindOfHomePresenter
		)
		public childrenDo: aBlock = (
			aBlock value: currentPresenter
		)
		public currentPresenter = (
			^currentPresenterX
		)
		public eraseHistory = (
			(* Forget all visits in the history and show the home page. *)
			
			navigator erase
		)
		public eraseHistoryEntry: aPresenter = (
			navigator eraseEntry: aPresenter
		)
		public isKindOfHopscotchShell = (
			^true
		)
		listenForBackButton = (
			window at: 'onpopstate'
				put: [:event <Alien[Event]> |
					userBack: event.
					nil
				]
		)
		navigationHistory = (
			^SinglePageNavigationHistory new
		)
		public replaceVisual: oldVisual <Alien[Element]> with: newVisual <Alien[Element]> = (
			(* Do nothing. This is just a stub so that all fragments,
       including the top level presenter can invoke this method uniformly *)
			
		)
		public shell = (
			^self
		)
		public showHistory = (
			enterPresenter: (HistoryPresenter onSubject: (HistorySubject onModel: navigator))
		)
		public sendDown ^<DownwardRequestDispatcher> = (
			(* Create and answer a RequestDispatcher that can deliver a downward request on behalf of the receiver. *)
			
			^DownwardRequestDispatcher sender: self
		)
		public receiveRequestFrom: dispatcher ^<Boolean> = (
			[ dispatcher message sendTo: self ] on: MessageNotUnderstood do: [ ^false ].
			^true
		)
		public navigatorDo: aBlock = (
			(* Process a request sent from somewhere in the presenter hierarchy to communicate with the navigator. The argument is a block that should be invoked with a navigator instance. *)
			
			^aBlock value: self
		)
		public registerNewPresenter: newPresenter <Presenter> = (
			assert: [
					newPresenter creatingWindow isNil or: [ newPresenter creatingWindow = self ]
				]
				message: 'Error: Attempt to register presenter from another window'.
			navigator registerNewPresenter: newPresenter
		)
		userBack: event = (
			| oldPresenter <Presenter> = navigator presenterFor: (event at: 'state'). newPresenter <Presenter> |
			oldPresenter isNil ifTrue: [
					^
					(* We've gone back in the web browser's history to before Hopscotch was running . *)
					self
				].
			newPresenter:: oldPresenter refreshmentPresenter.
			displayPresenter: newPresenter
		)
		public closeActiveMenu = (
			activeMenu isNil ifFalse: [
					[ activeMenuParent removeChild: activeMenu ] on: Error do: [:e | ].
					activeMenu: nil.
					activeMenuParent: nil
				]
		)
		public refresh = (
			| newSubject |
			
			(* get a new subject; abandon any non-model state; we are starting the "page" afresh *)
			newSubject:: currentPresenter subject refreshmentSubject.
			
			(* display the new view *)
			displayPresenter: newSubject presenter.
			
			(* Since refreshing forces a new copy of the current presenter into the browser, we need to massage it into the history as well. *)
			navigator replaceCurrentWith: newSubject presenter
		)
		public enterSubject: s <Subject> = (
			(* Must set the current window before subject computes its presenter. *)
			
			currentHopscotchWindow:: self.
			
			(* extract a (necessarily up-to-date) presenter for s and enter it *)
			self enterPresenter: s presenter
		)
		public updateDisplay = (
			(* This function is called on all windows, after an event that modifies the state of the application occurs.
    Computes an updated presenter and displays it. *)
			
			| oldPresenter <Presenter> = currentPresenter. newPresenter <Presenter> |
			currentHopscotchWindow:: self.
			newPresenter:: currentPresenter refreshmentPresenter.
			displayPresenter: newPresenter
		)
		public enterPresenter: presenter = (
			| oldPresenter newPresenter presenterToDisplay |
			
			(* Set the current window (just in case) *)
			currentHopscotchWindow:: self.
			
			(* If we came from enterSubject:, we always have a semantically correct presenter as a parameter (either the subject was new or old. If new, it computed a fresh presenter from the latest data. If  old, either an update happened since it was last asked for its presenter or not. If no update happened, its presenter is up to date. If an update has happened, the logic recomputes a fresh presenter. 

If we came from enterPresenter:, either we were passed a new presenter, which is accurate, or an old one (say, some cached presenter which may be obsolete at this point). 

In either case, the presenter may not be suitable for display at top level. It might be nested in another presenter, or it might be used at top level, but in another window (the problem being that such a presenter must not be reused, because we must maintain a tree of presenters).

We guard against all of the above problems by obtaining the refreshmentPresenter. *)
			newPresenter:: presenter refreshmentPresenter.
			
			(* An equivalent presenter may or may not have been displayed at the top level before. We check that by searching the history. *)
			presenterToDisplay:: navigator equalVisitOr: newPresenter.
			
			(* We are good to display presenterToDisplay. Add it to the history and display it *)
			navigator visit: presenterToDisplay.
			displayPresenter: presenterToDisplay
		)
		public displayPresenter: p = (
			(* TODO: noticeX events *)
			
			(* Make sure menus are removed before we transition presenters *)
			
			closeActiveMenu.
			
			(* Save the current top level presenter's scroll state before we leave it *)
			currentPresenter isNil ifFalse: [ currentPresenter setScrollPosition ].
			currentPresenterX:: p.
			assert: [ p creatingWindow isNil or: [ p creatingWindow = self ] ]
				message: 'Error: Attempt to display presenter from another window'.
			p parent: self.
			contentHolder hasChildNodes ifTrue: [
					contentHolder replaceChild: p visual from: (contentHolder at: 'firstChild')
				]
				ifFalse: [ contentHolder appendChild: p visual ].
			
			(* Make sure we scroll the newly displayed presenter to where it was last *)
			setToplevelScrollPosition: p scrollPosition.
			p noticeExposure
		)
		public activeMenuBlurred = (
			closeActiveMenu
		)
		public goHome = (
			atHome ifFalse: [ enterSubject: homeSubjectClass new ]
		)
		public goBack = (
			| oldPresenter <Presenter> |
			navigator goBack.
			oldPresenter:: navigator current.
			displayPresenter: oldPresenter refreshmentPresenter
		)
		public goForward = (
			| oldPresenter <Presenter> |
			navigator goForward.
			oldPresenter:: navigator current.
			displayPresenter: oldPresenter refreshmentPresenter
		)
	) : ()
	public class HopscotchWindow into: container openSubject: s = HopscotchShell new (
		listenForBackButton.
		container appendChild: toolbarHolder.
		container appendChild: contentHolder.
		toolbarHolder appendChild: ToolbarPresenter new visual.
		enterSubject: s.
	) (
		class ToolbarPresenter new = Presenter onSubject: nil (
		) (
			enterSubject: s <Subject> = (
				(* workaround so we can conveniently enter subjects, even though this presenter is not installed in a shell. *)
				
				^outer HopscotchWindow enterSubject: s
			)
			shell ^<HopscotchWindow> = (
				^outer HopscotchWindow shell
			)
			definition ^<Fragment> = (
				^column: {helpHolder. row: toolbarItems. smallBlank. }
			)
			historyButton ^<ButtonFragment> = (
				^(imageButton: historyImage action: [ showHistory ] size: styleButtonSize) toolTip: #history
			)
			refreshButton ^<ButtonFragment> = (
				^(imageButton: refreshImage
					action: [ outer HopscotchWindow refresh ]
					size: styleButtonSize) toolTip: #refresh
			)
			voiceControlButton ^<ButtonFragment> = (
				^(imageButton: mikeImage
					action: [ voiceController start ]
					size: styleButtonSize) toolTip: 'start voice control'
			)
			toolbarItems ^<Array[Fragment]> = (
				^{filler. historyButton. smallBlank. homeButton. smallBlank. refreshButton. smallBlank. helpButton. voiceControlButton. smallBlank. }
			)
		) : ()
		public displayPresenter: p = (
			super displayPresenter: p.
			setTitle: p title
		)
		public isKindOfHopscotchWindow = (
			^true
		)
		setTitle: t = (
			document at: 'title' put: t
		)
		public exit = (
			eraseHistory.
			body removeChild: toolbarHolder.
			body removeChild: contentHolder.
			windowList remove: self
		)
		public showHistory = (
			(* Make showHistory accessible to nested classes *)
			
			super showHistory
		)
	) : (
		public openSubject: s = (
			^into: body openSubject: s
		)
	)
	class HyperlinkFragment label: l action: a = LeafFragment new (
		|
			public label = l.
			action = a.
			public color ::= Color r: 0 g: 0 b: 1.
		|
	) (
		public isKindOfHyperlinkFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfHyperlinkFragment
		)
		public smallFont = (
			(visual at: 'style') at: 'font-size' put: 'smaller'
		)
		createVisual = (
			| container = document createElement: 'div'. anchor = document createElement: 'a'. |
			container at: 'id' put: 'HyperlinkFragmentContainer'.
			(container at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'column';
				at: 'justify-content' put: 'center';
				at: 'min-height' put: styleRowHeight;
				at: 'cursor' put: 'pointer'.
			container at: 'contentEditable' put: 'false'.
			anchor at: 'id' put: 'HyperlinkFragment'.
			anchor at: 'href' put: '#'.
			anchor at: 'onclick'
				put: [:event |
					action value.
					false
				].
			anchor appendChild: (document createTextNode: label).
			
			(* No underline *)
			(anchor at: 'style') at: 'textDecoration' put: 'none';
				at: 'overflow' put: 'hidden';
				at: 'white-space' put: 'nowrap'.
			anchor addEventListener: 'mouseover'
				action: [:event |
					(anchor at: 'style') at: 'textDecoration' put: 'underline'.
					nil
				];
				addEventListener: 'mouseout'
					action: [:event |
						(anchor at: 'style') at: 'textDecoration' put: 'none'.
						nil
					].
			color isNil ifFalse: [
					(anchor at: 'style') setProperty: 'color' to: color asCSSString
				].
			container appendChild: anchor.
			^container
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| oldVisual = oldFragment visual. anchor = oldVisual at: #firstChild. |
			anchor at: 'onclick'
				put: [:event |
					action value.
					false
				].
			label ~= oldFragment label ifTrue: [
					anchor replaceChild: (document createTextNode: label)
						replacing: (anchor at: 'firstChild')
				].
			color ~= oldFragment color ifTrue: [
					color isNil ifFalse: [
							(oldVisual at: 'style') setProperty: 'color' to: color asCSSString
						]
				].
			^oldVisual
		)
	) : ()
	class HyperlinkImageFragment image: i action: a = LeafFragment new (
		|
			image = i.
			action = a.
		|
	) (
		createVisual = (
			| img |
			img:: image cloneNode: false.
			
			(* Not deep *)
			img at: 'onclick'
				put: [:event |
					action value.
					false
				].
			^img
		)
		public isKindOfHyperlinkImageFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfHyperlinkImageFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| oldVisual = oldFragment visual. |
			#BOGUS.
			
			(* what if the actual image is different? *)
			oldVisual at: 'onclick'
				put: [:event |
					action value.
					false
				].
			^oldVisual
		)
	) : ()
	class ImageButtonFragment new = LeafFragment new (
		(* A button displayed as an image; or an image that acts as a button. *)
		
		|
			public action <[Object]>
			public image <Image>
		|
	) (
		createVisual ^<Visual> = (
			| div img |
			div:: document createElement: 'div'.
			div at: 'id' put: 'ImageButtonFragment'.
			(div at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'flex-column';
				at: 'align-items' put: 'center';
				at: 'cursor' put: 'pointer'.
			img:: image cloneNode: false.
			
			(* Not deep *)
			width = -1 ifFalse: [ widthStyle:: width printString , 'px' ].
			height = -1 ifFalse: [ heightStyle:: height printString , 'px' ].
			(img at: 'style') at: 'width' put: widthStyle;
				at: 'height' put: heightStyle;
				at: 'object-fit' put: 'contain'.
			img at: 'onclick'
				put: [:event |
					action value.
					false
				].
			img addEventListener: 'mousedown'
				action: [:event |
					(img at: 'style') at: 'filter' put: 'brightness(120%)'.
					nil
				];
				addEventListener: 'mouseover'
					action: [:event |
						(img at: 'style') at: 'filter' put: 'brightness(80%)'.
						nil
					];
				addEventListener: 'mouseout'
					action: [:event |
						(img at: 'style') at: 'filter' put: ''.
						nil
					].
			div appendChild: img.
			^div
		)
		public isKindOfImageButtonFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfImageButtonFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| oldVisual = oldFragment visual. img = oldVisual at: 'firstChild'. |
			#BOGUS.
			
			(* what if the actual image is different? *)
			img at: 'onclick'
				put: [:event |
					action value.
					false
				].
			^oldVisual
		)
	) : ()
	class LeafFragment new = Fragment new (
	) (
		lazy public properties <Map[Symbol, Object]> = Map new.
		public defaultHandler ^<[:Object | Object]> = (
			^[:event | ]
		)
		public childrenDo: aBlock = (
			(* No children. *)
			
		)
		public hasPendingChanges ^<Boolean> = (
			(* For simplicity, we assume that most leaf fragments can never have pending changes. Those for which it is not true should override this method. *)
			
			^false
		)
		public border: color <Color> = (
			border: color width: 1.0.
			visualModified
		)
		public border: color <Color> width: v <Float | Holder> = (
			| width <Float> subscription <Block> |
			v isKindOfHolder ifTrue: [
					width:: v value.
					subscription:: v changed => [:value |
						width:: value.
						style borderWidth: width.
						visualModified
					]
				]
				ifFalse: [ width:: v ].
			style borderColor: color.
			style borderWidth: width.
			width > 0 ifTrue: [ style borderType: 'solid' ].
			visualModified
		)
		public frame: width <Float> height: h <Float> = (
			width:: width.
			height:: h.
			visualModified
		)
		public foregroundColor: color <Color> = (
			style foregroundColor: color.
			visualModified
		)
		visualModified = (
			subclassResponsibility
		)
		applyStyle: element <Alien[HTMLElement]> = (
			element isNil ifTrue: [ ^self ].
			style isNil ifTrue: [ ^self ].
			width = -1 ifFalse: [ widthStyle:: width printString , 'px' ].
			height = -1 ifFalse: [ heightStyle:: height printString , 'px' ].
			(element at: 'style') at: 'width' put: widthStyle;
				at: 'height' put: heightStyle;
				at: 'max-width' put: widthStyle;
				at: 'max-height' put: heightStyle;
				at: 'background-color' put: style backgroundColor asCSSString;
				at: 'color' put: style foregroundColor asCSSString;
				at: 'border' put: 'none';
				at: 'border-radius' put: style cornerRadius asString , 'px'.
			'none' = style borderType ifFalse: [
					(element at: 'style') at: 'border' put: style borderType;
						at: 'border-color' put: style borderColor asCSSString;
						at: 'border-width' put: style borderWidth printString , 'px';
						at: 'border-style' put: style borderStyle
				]
		)
		registerGestures: element <Alien[HTMLElement]> = (
			element at: 'onclick'
				put: [:event |
					onClick value: event.
					false
				];
				at: 'onmousedown'
					put: [:event |
						onMouseDown value: event.
						false
					];
				at: 'onmouseenter'
					put: [:event |
						onMouseEnter value: event.
						false
					];
				at: 'onmousemove'
					put: [:event |
						onMouseMove value: event.
						false
					];
				at: 'onmouseout'
					put: [:event |
						onMouseOut value: event.
						false
					];
				at: 'onmouseover'
					put: [:event |
						onMouseOver value: event.
						false
					];
				at: 'onmouseup'
					put: [:event |
						onMouseUp value: event.
						false
					];
				at: 'ontouchstart'
					put: [:event |
						onTouchStart value: event.
						false
					];
				at: 'ontouchmove'
					put: [:event |
						onTouchMove value: event.
						false
					];
				at: 'ontouchend'
					put: [:event |
						onTouchEnd value: event.
						false
					];
				at: 'ontouchcancel'
					put: [:event |
						onTouchCancel value: event.
						false
					];
				at: 'onwheel'
					put: [:event |
						onWheel value: event.
						false
					]
		)
		public onClick: blk <[:Object | Object]> = (
			properties at: #onClick put: blk
		)
		public width: w <Float> = (
			properties at: #width put: w
		)
		public height: h <Float> = (
			properties at: #height put: h
		)
		public onMouseEnter: blk <[:Object | Object]> = (
			properties at: #onMouseEnter put: blk
		)
		public onMouseMove: blk <[:Object | Object]> = (
			properties at: #onMouseMove put: blk
		)
		public onMouseDown: blk <[:Object | Object]> = (
			properties at: #onMouseDown put: blk
		)
		public onMouseOut: blk <[:Object | Object]> = (
			properties at: #onMouseOut put: blk
		)
		public onMouseOver: blk <[:Object | Object]> = (
			properties at: #onMouseOver put: blk
		)
		public onMouseUp: blk <[:Object | Object]> = (
			properties at: #onMouseUp put: blk
		)
		public onTouchCancel: blk <[:Object | Object]> = (
			properties at: #onTouchCancel put: blk
		)
		public onTouchEnd: blk <[:Object | Object]> = (
			properties at: #onTouchEnd put: blk
		)
		public onTouchMove: blk <[:Object | Object]> = (
			properties at: #onTouchMove put: blk
		)
		public onTouchStart: blk <[:Object | Object]> = (
			properties at: #onTouchStart put: blk
		)
		public onWheel: blk <[:Object | Object]> = (
			properties at: #onWheel put: blk
		)
		public heightStyle: h <String> = (
			properties at: #heightStyle put: h
		)
		public widthStyle: w <String> = (
			properties at: #widthStyle put: w
		)
		public height ^<Float> = (
			^properties at: #height ifAbsent: [ -1 ]
		)
		public width ^<Float> = (
			^properties at: #width ifAbsent: [ -1 ]
		)
		public widthStyle ^<String> = (
			^properties at: #widthStyle ifAbsent: [ 'auto' ]
		)
		style ^<Style> = (
			^properties at: #style ifAbsentPut: [ Style new ]
		)
		public onWheel ^<[:Object | Object]> = (
			^properties at: #onWheel ifAbsent: [ defaultHandler ]
		)
		public onTouchStart ^<[:Object | Object]> = (
			^properties at: #onTouchStart ifAbsent: [ defaultHandler ]
		)
		public onTouchMove ^<[:Object | Object]> = (
			^properties at: #onTouchMove ifAbsent: [ defaultHandler ]
		)
		public onTouchEnd ^<[:Object | Object]> = (
			^properties at: #onTouchEnd ifAbsent: [ defaultHandler ]
		)
		public onTouchCancel ^<[:Object | Object]> = (
			^properties at: #onTouchCancel ifAbsent: [ defaultHandler ]
		)
		public onMouseUp ^<[:Object | Object]> = (
			^properties at: #onMouseUp ifAbsent: [ defaultHandler ]
		)
		public onMouseOver ^<[:Object | Object]> = (
			^properties at: #onMouseOver ifAbsent: [ defaultHandler ]
		)
		public onMouseOut ^<[:Object | Object]> = (
			^properties at: #onMouseOut ifAbsent: [ defaultHandler ]
		)
		public onMouseMove ^<[:Object | Object]> = (
			^properties at: #onMouseMove ifAbsent: [ defaultHandler ]
		)
		public onMouseEnter ^<[:Object | Object]> = (
			^properties at: #onMouseEnter ifAbsent: [ defaultHandler ]
		)
		public onMouseDown ^<[:Object | Object]> = (
			^properties at: #onMouseDown ifAbsent: [ defaultHandler ]
		)
		public onClick ^<[:Object | Object]> = (
			^properties at: #onClick ifAbsent: [ defaultHandler ]
		)
		public heightStyle ^<String> = (
			^properties at: #heightStyle ifAbsent: [ 'auto' ]
		)
	) : ()
	class MultiPageNavigationHistory new = NavigationHistory new (
		(* This class serves the needs of single window where an application occupies multiple windows on a page.

Each window has a numeric id. 
When a new presenter is displayed, it is given an id. Ids start at 1. Allocating an id involves 
incrementing a counter (nextId) and placing the new id in a map, #ids, keyed by the new presenter. Actual allocation happens in #idFor: . Each position in the history
of the navigation is associated with the numeric id of the presenter being displayed.

When moving forward or backward, we index into the history to find the id, and that id is used to lookup the presenter.
Lookup is done via the method #presenterFor:, which either finds an existing entry in #ids, 
or returns nil.  

Presenter equality is based on subject equality. Developers determine subject equality, which defaults to model equality.
Hence looking up an id for a presenter on an existing (or more generally, equivalent) subject
always works, even when fresh presenters are computed. This should ensure that #presenterFor: 
never returns nil as long as it is passed the id of an existing history entry.

When navigating to a new presenter (e.g., via a link or button) we must always check whether an equivalent presenter
exists in the history, so that we display the correct presenter state. This check is done via
#equalVisitOr:.  If an old presenter is returned, the caller must use it to update the new one
to the proper state. 

The above paragraph also holds when updating an existing presenter due to subject/model changes.

The navigator must be told that the newly computed presenter is the latest
version in its equivalence class, so that:

a. The keys of #ids are updated, so that lookups for #presenterFor: used during history navigation
    return correct results.
b.  To prevent memory leaks which would occur if we kept old presenters live via the keys of #ids.

This should be done by calling #registerNewPresenter: *)
		
	) (
		class EventHistory new = Object new (
			|
				pages <List[Number]> ::= List withAll: {nextId. }.
				currentIndex ::= 1.
			|
		) (
			public moveForward = (
				currentIndex:: currentIndex + 1 min: pages size
			)
			public moveBack = (
				currentIndex:: currentIndex - 1 max: 1
			)
			public eraseFuture = (
				pages:: pages copyFrom: 1 to: currentIndex
			)
			public pushState: state <Number> title: t = (
				pages add: state.
				moveForward
			)
			public erasePast = (
				pages:: pages copyFrom: currentIndex to: pages size.
				currentIndex:: 1
			)
		) : ()
		lazy history <EventHistory> = EventHistory new.
		recordFirst: presenter <Presenter> = (
			ids at: presenter put: nil
		)
		public visit: newPresenter
		(* provide access for EventHistory *)
		 = (
			newPresenter isTransient ifFalse: [
					nil = currentVisitSlot ifTrue: [ recordFirst: newPresenter ]
						ifFalse: [
							history pushState: (idFor: newPresenter) title: newPresenter title
						]
				].
			super visit: newPresenter
		)
		erasePast = (
			history erasePast.
			past:: List new
		)
		eraseFuture = (
			history eraseFuture.
			future:: List new
		)
		nextId ^<Number>
		(* NavigationHistory is a richly structured collection that maintains a web browser-like history of ''visits''. Visits are arbitrary objects. NavigationHistory makes no assumptions about visits other than that they can be compared using #=.

The important attributes of a history are: the ''current'' visit, the ''past'', the ''future'' and ''allVisits''. A history starts off empty. To visit an object, send the #visit: message to the history with the object as the argument. This makes the object the ''current'' object of the history.

The ''past'' is a queue of visits that used to be the current (most recently current object last). Sending the #goBack message makes the most recently current object from the past the current again, while the current object becomes the first member of the ''future'' queue. Sending the #goForward message reverses the process. Visiting an object other than the first element of the ''future'' queue erases the future queue.

All visits visited by a history are remembered in the ''allVisits'' set. This set is never emptied, other than on an explicit request.

A history can optionally be configured with a transientTestBlock. The test block is applied to visits to determine whether they are transient or not. Transient visits are not recorded in the ''past'' and ''future'' queues and in the ''allVisits'' set. By default all visits are considered to be non-transient.

In addition, each visit has a numeric id.  The ids are useful for interacting with the DOM, and only really necessary in the case of a single page
application (see class SinglePageNavigationHistory). However, since HopscotchForHTML5 must implement single page navigation in any case, we define the mechanism here, so we can reuse it in the multi-window case as well.  

When a new presenter is displayed, it is given an id. Ids start at 1. Allocating an id involves 
incrementing a counter (nextId) and placing the new id in a map, #ids, keyed by the new presenter. 
We assume that numbers are large enough to track all the presenters in an application. When running
on Javascript these are doubles. We will run out of memory, both digital and human, long before we hit that limit. In Psoup, they are integers and unbounded.
Actual allocation happens in #idFor: .

Because the ids are used for interacting with the browser, they cannot be erased.

When navigating to a new presenter (e.g., via a link or button) we must always check whether an equivalent presenter
exists in the history, so that we display the correct presenter state. This check is done via
#equalVisitOr:.  If an old presenter is returned, the caller must use it to update the new one
to the proper state. 

Presenter equality is based on subject equality. Developers determine subject equality, which defaults to model equality.
Hence looking up an id for a presenter on an existing (or more generally, equivalent) subject
always works, even when fresh presenters are computed. This should ensure that #presenterFor: 
never returns nil as long as it is passed the id of an existing page.

The above paragraph also holds when updating an existing presenter due to subject/model changes.

The navigator must be told that the newly computed presenter is the latest
version in its equivalence class, so that:

a. The keys of #ids are updated, so that lookups for #presenterFor: used during history navigation
    return correct results.
b.  To prevent memory leaks which would occur if we kept old presenters live via the keys of #ids.

This should be done by calling #registerNewPresenter: *)
		 = (
			^super nextId
		)
		moveHistoryBack = (
			history moveBack
		)
		moveHistoryForward = (
			history moveForward
		)
	) : ()
	class NavigationHistory new = Object new (
		|
			currentVisitSlot
			public allVisits <List>
			public past <List>
			public future <List>
			public transientTestBlock <[:Object | Boolean]> ::= [:element |
				element isTransient
			].
			nextId ::= 1.
			ids <Map[Presenter, Integer]> = Map new.
		|
		erase.
	) (
		public allIdKeys ^<List[Presenter]> = (
			^ids keys
		)
		public current ^<Object> = (
			^currentVisitSlot
		)
		public do: aBlock
		(* Do the current visit separately if transient because it's not among allVisits. *)
		 = (
			(isTransient: currentVisitSlot) ifTrue: [ aBlock value: currentVisitSlot ].
			allVisits do: aBlock
		)
		eraseFuture = (
			future:: List new
		)
		erasePast = (
			past:: List new
		)
		public goToFutureItem: anObject = (
			[ currentVisitSlot = anObject or: [ isFutureEmpty ] ] whileFalse: [
					goForward
				]
		)
		public goToPastItem: anObject = (
			[ currentVisitSlot = anObject or: [ isPastEmpty ] ] whileFalse: [ goBack ]
		)
		includesVisit: anObject ^<Boolean> = (
			^allVisits includes: anObject
		)
		isEmpty ^<Boolean> = (
			^allVisits isEmpty
		)
		public isFutureEmpty ^<Boolean> = (
			^future isEmpty
		)
		public isPastEmpty ^<Boolean> = (
			^past isEmpty
		)
		isTransient: anObject ^<Boolean> = (
			^transientTestBlock value: anObject
		)
		next ^<Object>
		(* Answer the closest visit from the future. Fail if the future is empty. *)
		 = (
			^future first
		)
		previous ^<Object>
		(* Answer the most recent visit from the past. Fail if the past is empty. *)
		 = (
			^past last
		)
		public replaceCurrentWith: anObject = (
			self replace: currentVisitSlot with: anObject
		)
		public visit: anObject
		(* Make the argument the current object of the history. The prior current object becomes the last object of the 'past' queue. The 'future' queue is erased, unless the visit is equal to the first element of the future. *)
		 = (
			currentVisitSlot = anObject ifTrue: [ ^self ].
			((nil = currentVisitSlot) not and: [ (isTransient: currentVisitSlot) not ]) ifTrue: [
					past addLast: currentVisitSlot
				].
			currentVisitSlot:: anObject.
			(isTransient: anObject) ifFalse: [
					allVisits remove: anObject ifAbsent: [ ];
						add: anObject
				].
			future isEmpty not ifTrue: [
					future first = currentVisitSlot ifTrue: [ future removeFirst ]
						ifFalse: [ eraseFuture ]
				]
		)
		replace: anObject with: replacement = (
			(* Replace all references to anObject that we have with references to 'replacement'. *)
			
			allVisits remove: anObject ifAbsent: [ ].
			(isTransient: replacement) ifFalse: [ allVisits add: replacement ].
			currentVisitSlot = anObject ifTrue: [ currentVisitSlot:: replacement ].
			past keysAndValuesDo: [:index :each |
					each = anObject ifTrue: [ past at: index put: replacement ]
				].
			future keysAndValuesDo: [:index :each |
					each = anObject ifTrue: [ future at: index put: replacement ]
				]
		)
		public erase = (
			currentVisitSlot:: nil.
			allVisits:: List new.
			erasePast.
			eraseFuture
		)
		public equalVisitOr: anObject ^<Object> = (
			(* Return a visit from the history equal to the argument, or the argument itself if there is no equal visit in the history. *)
			
			^allIdKeys detect: [:some | some = anObject ] ifNone: [ anObject ]
		)
		idFor: presenter <Presenter> ^<Integer> = (
			^ids at: presenter ifAbsentPut: [ nextId:: nextId + 1 ]
		)
		public presenterFor: id <Integer> ^<Presenter | Nil> = (
			ids keysAndValuesDo: [:key :value | value = id ifTrue: [ ^key ] ].
			^nil
		)
		public eraseEntry: anObject = (
			allVisits remove: anObject ifAbsent: [ ].
			past remove: anObject ifAbsent: [ ].
			future remove: anObject ifAbsent: [ ]
			(* can it ever be in the future list? *)
			
		)
		public goToFutureIndex: i <Integer> = (
			1 to: i do: [:dontCare | goForward ]
		)
		public goToPastIndex: i <Integer> = (
			1 to: i do: [:dontCare | goBack ]
		)
		public registerNewPresenter: newPresenter <Presenter> = (
			| oldPresenter <Presenter> = equalVisitOr: newPresenter. |
			oldPresenter == newPresenter ifTrue: [
					
					(* In this case, newPresenter was truly new and there was no actual oldPresenter, so equalVisitOr: returned its argument. *)
					idFor: newPresenter
				]
				ifFalse: [
					| id <Number> = idFor: oldPresenter. |
					
					(* update the new presenter state based on the old presenter *)
					newPresenter updateVisualsFrom: oldPresenter.
					
					(* update the cached history to contain the new presenter *)
					ids removeKey: oldPresenter.
					ids at: newPresenter put: id.
					replace: oldPresenter with: newPresenter
				]
		)
		moveHistoryBack = (
			subclassResponsibility
		)
		moveHistoryForward = (
			subclassResponsibility
		)
		public goBack = (
			isPastEmpty ifFalse: [
					(isTransient: currentVisitSlot) ifFalse: [
							future addFirst: currentVisitSlot
						].
					moveHistoryBack.
					currentVisitSlot:: past removeLast
				]
		)
		public goForward = (
			isFutureEmpty ifFalse: [
					(isTransient: currentVisitSlot) ifFalse: [ past addLast: currentVisitSlot ].
					moveHistoryForward.
					currentVisitSlot:: future removeFirst
				]
		)
	) : ()
	class PaddedFrameComposer content: c offsets: o = Composer new (
		|
			public content = c.
			offsets = o.
			public color
		|
	) (
		public childrenDo: aBlock = (
			nil = content ifFalse: [ aBlock value: content ]
		)
		createVisual = (
			| div = document createElement: 'div'. |
			div at: 'id' put: 'PaddedFrameComposer'.
			(div at: 'style') at: 'paddingLeft' put: (offsets at: 1) printString , 'px';
				at: 'paddingTop' put: (offsets at: 2) printString , 'px';
				at: 'paddingRight' put: (offsets at: 3) printString , 'px';
				at: 'paddingBottom' put: (offsets at: 4) printString , 'px'.
			color isNil ifFalse: [ color applyToStyle: (div at: 'style') ].
			content parent: self.
			div appendChild: content visual.
			^div
		)
		public isKindOfPaddedFrameComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfPaddedFrameComposer
		)
		updateVisualsFromSameKind: oldFragment <PaddedFrameComposer> ^<Alien[Element]> = (
			content parent: self.
			content updateVisualsFrom: oldFragment content.
			color ~= oldFragment color ifTrue: [
					color isNil ifFalse: [
							color applyToStyle: (oldFragment visual at: 'style')
						]
				].
			^oldFragment visual
		)
	) : ()
	public class Presenter onSubject: aSubject <Subject> = Fragment new (
		(* Subclasses of Presenter must implement the method #isMyKind:.
 The implementation is #isMyKind: is formulaic, calling #isKindOfX for whatever type X the presenter represents, e.g, for class FooPresenter:
 
 isMyKind: other <Fragment> ^ <Boolean> = (^isKindOfFooPresenter)

Stateful presenters require extra care. In some cases, they may have to override #updateVisualsFromSameKind: so that
the relevant state is preserved when the GUI is updated.

Care must also be taken for any subpresenters used by a presenter. If a subpresenter is used in multiple parts of a definition,
distinct copies may be computed unless the subpresenter is explicitly cached. These copies may get out of sync causing bugs,
depending on how they are used. *)
		
		|
			public subject <Subject> ::= aSubject.
			substanceSlot <Fragment>
			public generation <Number> = uiGeneration.
			helpHolder = holder: nothing.
			public scrollPosition <Number> ::= 0.
		|
	) (
		public = anotherPresenter = (
			(* Underlying this model are assumptions about Presenter equality; 
   two presenters are equal iff they are of the same class and have equal subjects, and they do not belong to different windows. *)
			
			^(isMyKind: anotherPresenter) and: [
					subject = anotherPresenter subject and: [
							creatingWindowCompatibleWith: anotherPresenter
						]
				]
		)
		aiChat: aChatSubject = (
			^outer HopscotchForHTML5 ChatPresenter onSubject: aChatSubject
		)
		aiChatSetup: providerClass = (
			^outer HopscotchForHTML5 AIChatSetupPresenter onSubject: (outer HopscotchForHTML5 AIChatSetupSubject onModel: providerClass)
		)
		alert: text = (
			window alert: text
		)
		prompt: title <String> input: i <String> ^<String> = (
			^window prompt: title input: i
		)
		blank: size = (
			^BlankFragment new size: size
		)
		button: label <String | HTMLFragment> action: block <[Object]> = (
			(* label may be a plain String or an HTMLFragment; an HTMLFragment's
   HTML becomes the button's contents (rich/sized/coloured text). *)
			
			^ButtonFragment label: label action: block
		)
		canvas: extent <Point> = (
			^CanvasFragment withExtent: extent
		)
		colorPicker: value <Holder> action: a <[:Boolean | Object]> = (
			^ColorPickerFragment value: value action: a
		)
		datePicker: value <Holder> action: a <[:Boolean | Object]> = (
			^DatePickerFragment value: value action: a
		)
		picker: text <String> items: i <List[String]> action: a <[:String | Object]> = (
			^PickerFragment text: text items: i action: a
		)
		progressBar: value <Float | Holder> = (
			^ProgressBarFragment value: value
		)
		radioButton: text <String> value: v <Holder> group: g <Integer> action: a <[:Boolean | Object]> = (
			^RadioButtonFragment text: text value: v group: g action: a
		)
		rectangle = (
			^RectangleFragment new
		)
		slider: value <Holder> min: mn <Float> max: mx <Float> = (
			^SliderFragment value: value min: mn max: mx
		)
		timePicker: value <Holder> action: a <[:Boolean | Object]> = (
			^TimePickerFragment value: value action: a
		)
		public childrenDo: aBlock = (
			nil = substanceSlot ifFalse: [ aBlock value: substanceSlot ]
		)
		codeMirror: t <Text | String> = (
			^CodeMirrorFragment onText: t
		)
		collapsed: collapsed <[Fragment]> expanded: expanded <[Fragment]> ^<Fragment> = (
			^collapsed: collapsed expanded: expanded initiallyExpanded: false
		)
		collapsed: collapsed <[Fragment]> expanded: expanded <[Fragment]> initiallyExpanded: flag <Boolean> ^<ToggleComposer> = (
			^ToggleComposer collapsedDefinition: collapsed
				expandedDefinition: expanded
				initiallyExpanded: flag
		)
		collapsed: collapsed <[Fragment]> expanded: expanded <[Fragment]> initiallyExpanded: flag <Boolean> tag: t <String> ^<ToggleComposer> = (
			^(ToggleComposer collapsedDefinition: collapsed
				expandedDefinition: expanded
				initiallyExpanded: flag) tag: t;
				yourself
		)
		collapsed: collapsed <[Fragment]> expanded: expanded <[Fragment]> tag: t <String> ^<Fragment> = (
			^collapsed: collapsed expanded: expanded initiallyExpanded: false tag: t
		)
		column: definitions <List[Fragment]> ^<ColumnComposer> = (
			^ColumnComposer definitions: definitions
		)
		createVisual ^<Alien[HTMLElement]> = (
			^substance visual
		)
		public creatingWindow ^<HopscotchWindow> = (
			^parent isNil ifFalse: [ shell ]
		)
		deferred: contentSource <[Fragment]> ^<Fragment> = (
			^DeferredContentComposer initialContent: nothing contentSource: contentSource
		)
		navBarFragmentWithItems: items <List> content: c <Fragment> ^<Fragment> = (
			^NavBarFragment items: items content: c
		)
		webTransclusionFragmentTranscluding: name <String> content: c <Fragment> lazily: lz <Boolean> titled: t <String> ^<Fragment> = (
			^WebTransclusionFragment transcluding: name content: c lazily: lz titled: t
		)
		asyncContent: producer <[:Object | Object]> initially: ic <Fragment> ^<Fragment> = (
			(* A fragment that shows `ic` immediately, then runs `producer`, handing
     it a one-argument `fill` callback. When the producer's async work
     completes, it calls `fill value: aFragment` and that fragment replaces the
     placeholder. See AsyncContentComposer. *)
			
			^AsyncContentComposer initially: ic producer: producer
		)
		public definition ^<Fragment> = (
			subclassResponsibility
		)
		dropDownMenu: menu <[Menu]> ^<DropDownMenuFragment> = (
			^DropDownMenuFragment menu: menu
		)
		dropDownMenu: menu <[Menu]> image: img <Image> ^<DropDownMenuFragment> = (
			^DropDownMenuFragment menu: menu image: img
		)
		dropDownMenu: menu <[Menu]> alignment: side <Symbol> ^<DropDownMenuFragment> = (
			^DropDownMenuFragment menu: menu alignment: side
		)
		dropDownMenu: menu <[Menu]> images: img <Image> alignment: side <Symbol> ^<DropDownMenuFragment> = (
			^DropDownMenuFragment menu: menu image: img alignment: side
		)
		elastic: aFragment = (
			aFragment elasticity: 1.
			^aFragment
		)
		ensureSubstance = (
			nil = substanceSlot ifTrue: [
					substanceSlot:: self definition.
					substanceSlot parent: self.
					noticeSubstanceCreation
				]
		)
		enterPresenter: s = (
			(* TODO: use sendUp and open a new window if undelivered *)
			
			^shell enterPresenter: s
		)
		enterSubject: s <Subject> fromSnippet: snippet <SnippetSubject> = (
			(* TODO: use sendUp and open a new window if undelivered *)
			
			^shell enterSubject: s fromSnippet: snippet
		)
		expanded: expanded <[Fragment]> collapsed: collapsed <[Fragment]> ^<Fragment> = (
			^collapsed: collapsed expanded: expanded initiallyExpanded: true
		)
		extraInformationMetapresenter ^<Presenter> = (
			^nothing
		)
		fileChooser = (
			^FileChooserFragment new
		)
		filler = (
			^BlankFragment new expansibility: 1;
				compressibility: 1
		)
		hasSubstance ^<Boolean> = (
			^nil ~= substanceSlot
		)
		public hash = (
			^subject hash
		)
		holder: def <Fragment | [Fragment]> = (
			^HolderComposer withContent: def
		)
		image: image <Image> = (
			| fragment <StaticImageFragment> |
			fragment:: StaticImageFragment image: image.
			^fragment
		)
		imageButton: image <Image> action: block <[Object]> = (
			^ImageButtonFragment new image: image;
				action: block
		)
		imageButton: image <Image> action: block <[Object]> size: s <Float> = (
			^ImageButtonFragment new image: image;
				action: block;
				width: s;
				height: s
		)
		initially: initialContent <Fragment> deferred: contentSource <[Fragment]> ^<Fragment> = (
			^DeferredContentComposer initialContent: initialContent
				contentSource: contentSource
		)
		public isKindOfPresenter ^<Boolean> = (
			^true
		)
		public isNested ^<Boolean> = (
			parent isNil ifTrue: [ ^false ].
			^parent isKindOfHopscotchShell not
		)
		public isTransient = (
			(* Should visits of this presenter be omitted from the navigation history? *)
			
			^false
		)
		label: label <String> ^<StaticLabelFragment> = (
			^StaticLabelFragment text: label
		)
		label: label <String> weight: weight <Symbol> ^<StaticLabelFragment> = (
			| fragment |
			fragment:: StaticLabelFragment text: label.
			fragment weight: weight.
			^fragment
		)
		link: label <String> action: block <[Object]> = (
			^HyperlinkFragment label: label action: block
		)
		linkImage: image action: block = (
			^HyperlinkImageFragment image: image action: block
		)
		public listElementMetapresenter ^<Presenter> = (
			(* A presenter that can represent the receiver in a list of presenters such as the History. *)
			
			^row: {minimalMetapresenter. mediumBlank. deferred: [
						hasPendingChanges ifTrue: [ (label: 'has unsaved edits') bold ]
							ifFalse: [ nothing ]
					]. filler compressibility: 0. (deferred: [ extraInformationMetapresenter ]) compressibility: 1. }
		)
		minimalMetapresenter ^<Presenter> = (
			(* A minimal presenter that can represent the receiver in places such as the History. *)
			
			^row: {link: title action: [ enterPresenter: self ]. }
		)
		multipleFileChooser = (
			^FileChooserFragment allowMultiples: true
		)
		nothing = (
			^BlankFragment new
		)
		noticeSubstanceCreation = (
			(* Received after the #definition method of the receiver has been invoked and the result remembered as its substance. The substance hasn't been asked to create a visual yet. *)
			
		)
		openMenuWithLabelsAndActions: labelsAndActions = (
			openMenu: (menuWithLabelsAndActions: labelsAndActions)
		)
		padded: def with: offsets = (
			^PaddedFrameComposer content: def offsets: offsets
		)
		row: definitions = (
			^RowComposer definitions: definitions
		)
		schedule: action <[Object]> = (
			window setTimeout: [
					action value.
					nil
				]
				with: 0
		)
		public substance ^<Fragment> = (
			ensureSubstance.
			^substanceSlot
		)
		text: t <Text> = (
			| subfragments <Collection[Fragment]> |
			t isKindOfTextString ifTrue: [ ^TextStringFragment onText: t ].
			subfragments:: t textUnits collect: [:u <Text> | text: u ].
			^TextBlockFragment onText: t subfragments: subfragments
		)
		textDisplay: string = (
			^TextDisplayFragment text: string
		)
		textField: initialText onAccept: blk = (
			(* experimental *)
			
			^fragments TextEditorFragment new text: initialText;
				acceptResponse: blk
			(* [:editor | blk valueWithPossibleArgument: editor. editor defaultAcceptResponse] *)
			
		)
		textString: string <String> = (
			^TextStringFragment forString: string
		)
		textString: string <String> properties: tps <TextProperties> = (
			^TextStringFragment forString: string properties: tps
		)
		public title ^<String> = (
			^subject title
		)
		zebra: sequence <Sequence[Fragment]> ^<Sequence[Fragment]> = (
			sequence addDecorator: ZebraDecorator lighterColorFirst.
			^sequence
		)
		public receiveRequestFrom: dispatcher ^<Boolean> = (
			[ dispatcher message sendTo: self ] on: MessageNotUnderstood do: [ ^false ].
			^true
		)
		creatingWindowCompatibleWith: p <Presenter> ^<Boolean> = (
			creatingWindow isNil ifTrue: [ ^true ].
			p creatingWindow isNil ifTrue: [ ^true ].
			^creatingWindow = p creatingWindow
		)
		smallBlank = (
			^blank: 5
		)
		mediumBlank = (
			^blank: 10
		)
		html: h <String> = (
			^HTMLFragment html: h
		)
		menuWithLabelsAndActions: labelsAndActions <{Symbol | {String. [Object]}}> ^<Menu> = (
			| menu |
			^labelsAndActions
			(* menu:: Menu forVisual: visual.
	labelsAndActions do:
		[:each |
		menu add: (#separator = each
			ifTrue: [SeparatorItem new]
			ifFalse: [MenuItem key: nil label: each key action: each value])].
	^menu *)
			
		)
		openMenu: aMenu <Menu> = (
			showMenu: (computeContentForMenu: [ aMenu ]) forShell: shell inVisual: visual
		)
		ampleforth: h <String> mapping: m <Map[String, Fragment]> = (
			^AmpleforthFragment html: h mapping: m
		)
		helpContents = (
			^column: {row: {filler. closeHelpButton. }. helpText. }
		)
		helpText ^<Fragment> = (
			^textDisplay: 'No help text defined for this presenter. Sorry.'
		)
		closeHelpButton = (
			^(imageButton: clearImage action: [ helpHolder content: nothing ]) height: styleButtonSize
		)
		registerNewPresenter: p <Presenter> = (
			parent isNil ifTrue: [
					
					(* uninstalled presenter passed from enterPresenter: *)
					currentHopscotchWindow registerNewPresenter: p
				]
				ifFalse: [
					
					(* register and return *)
					shell registerNewPresenter: p
				]
		)
		validTopLevel: p <Presenter> ^<Boolean> = (
			^(p isNested not and: [ creatingWindow = p shell ]) and: [
					p generation = uiGeneration
				]
		)
		public alternateRefreshmentPresenter ^<Self class> = (
			(* An attempt to simplify the algorithm *)
			
			| oldPresenter <Presenter> = equalVisitOr: self. |
			^oldPresenter ~= self ifTrue: [
					
					(* equivalent presenter exists *)
					(validTopLevel: oldPresenter) ifTrue: [
							
							(* old one is valid; use it *)
							oldPresenter
						]
						ifFalse: [
							
							(* old one is invalid *)
							(validTopLevel: self) ifTrue: [
									
									(* I'm valid; use me *)
									registerNewPresenter: self
								]
								ifFalse: [
									
									(* Use a fresh valid version of myself *)
									refreshmentPresenterOfMyClass
								]
						]
				]
				ifFalse: [
					
					(* No top level equivalent *)
					(validTopLevel: self) ifTrue: [
							
							(* I'm valid; use me *)
							registerNewPresenter: self
						]
						ifFalse: [
							
							(* Use a fresh valid version of myself *)
							refreshmentPresenterOfMyClass
						]
				]
		)
		enterSubject: s = (
			(* TODO: use sendUp and open a new window if undelivered *)
			
			^shell enterSubject: s
		)
		taggedColumn: ts <Sequence[ToggleComposer]> ^<TaggedColumnComposer> = (
			^TaggedColumnComposer definitions: ts
		)
		taggedRow: ts <Sequence[ToggleComposer]> ^<TaggedRowComposer> = (
			^TaggedRowComposer definitions: ts
		)
		public refreshmentPresenter ^<Self> = (
			(* Produce an equivalent, up to date (i.e., semantically valid) presenter that is suitable for display at the top level of a window.
 It also registers the presenter with the navigator, so we track it as being presented at top level etc. It would be cleaner to restructure per this documentation. *)
			
			(* Get a semantically valid presenter, in case the receiver is obsolete. The result, newPresenter, may be an existing presenter or a newly computed one (depending on whether the subject already had an up to date presenter). It may be identical to the receiver (if the receiver is up to date and computed by the subject), or it may be a different instance of the same class (if it is out of date, or if it was not computed by the subject), or it may be of a different class entirely (if the receiver is not of the default presenter class of the subject).
  
  In the latter case, it is not equivalent to the receiver and cannot be returned. In any case, it might not be suitable for top level display because it is nested or part of a window other than the current one. Since the display hierarchy must form a tree, such a presenter is not a valid result for this method. The rest of this method deals with all these scenarios. *)
			
			| newPresenter <Presenter> = subject presenter. |
			newPresenter scrollPosition: scrollPosition.
			
			(* It may be that newPresenter belongs to another window, and cannot be displayed at top level elsewhere.  Therefore, return a new presenter. *)
			(newPresenter parent isNil not and: [ creatingWindow ~= newPresenter shell ]) ifTrue: [
					^refreshmentPresenterOfMyClass
				].
			
			(* newPresenter is nested in another presenter.   Again, in that case, newPresenter cannot be displayed at top level elsewhere.  Therefore, return a new presenter. *)
			newPresenter isNested ifTrue: [ ^refreshmentPresenterOfMyClass ].
			
			(* newPresenter is of the same kind as the receiver.  It is not nested, nor is it from another window. It can be displayed at top level *)
			(isMyKind: newPresenter) ifTrue: [
					registerNewPresenter: newPresenter.
					^
					(* register and return. Registering compares to old presenter as needed. *)
					newPresenter
				].
			
			(* I am not the subject's standard kind of presenter, so newPresenter is of a different kind.  We  need to compute a new presenter of the same class as the receiver. *)
			^refreshmentPresenterOfMyClass
		)
		refreshmentPresenterOfMyClass ^<Self> = (
			| newPresenter = class onSubject: subject. |
			
			(* create a new instance of my class *)
			newPresenter scrollPosition: scrollPosition.
			registerNewPresenter: newPresenter.
			
			(* register and return *)
			^newPresenter
		)
		public setScrollPosition = (
			(* Remember how far the display is scrolled *)
			
			scrollPosition:: toplevelScrollPosition
		)
		holder: def <Fragment | [Fragment]> tag: t <Symbol> = (
			^TaggedHolderComposer withContent: def tag: t
		)
		public helpSection = (
			^helpHolder
		)
		updateVisualsFromSameKind: oldPresenter <Self> ^<Alien[Element]> = (
			(* A Presenter's visual is determined by its substance, so by default we 
   update the substance from the old presenter's substance.
   Subclasses may need to override or extend this behavior if the presenter has state
  or if there are semantic reasons that make correlating the substances
  difficult or impossible. *)
			
			(* Ensure we retain help status after update *)
			
			oldPresenter helpSection content isKindOfBlankFragment ifFalse: [
					helpHolder content: helpContents
				].
			substance updateVisualsFrom: oldPresenter substance.
			^replaceVisual: oldPresenter visual with: substance visual
		)
		helpButton = (
			^(imageButton: helpImage action: [ helpHolder content: helpContents ]) height: styleButtonSize;
				toolTip: #help
		)
		homeButton = (
			^(imageButton: homeImage
				action: [ enterSubject: homeSubjectClass new ]
				size: styleButtonSize) toolTip: 'Return to home screen'
		)
		ampleforth: h <String> mapping: m <Map[String, Fragment]> expressions: em <Map[String, String]> = (
			^AmpleforthFragment html: h mapping: m expressions: em
		)
		embeddedWindowOn: s <Subject> ^<EmbeddedHopscotchWindow> = (
			^WindowFragment openSubject: s
		)
		audioPlayer: uri = (
			^AudioPlayerFragment uri: uri
		)
		videoPlayer: uri = (
			^VideoPlayerFragment uri: uri
		)
		imageFromURI: uri <String> = (
			| fragment <ImageElementFragment> |
			fragment:: ImageElementFragment uri: uri.
			^fragment
		)
		mediaFromFileNamed: f <String> type: t <String> registry: r <Map[String, Blob]> ^<MediaCreatorFragment> = (
			^MediaCreatorFragment type: t name: f registry: r
		)
		imageFromURI: uri <String> width: w = (
			| fragment <ImageElementFragment> |
			fragment:: ImageElementFragment uri: uri width: w.
			^fragment
		)
		mediaFromFileNamed: f <String> type: t <String> registry: r <Map[String, Blob]> width: w <String> ^<MediaCreatorFragment> = (
			^MediaCreatorFragment type: t name: f registry: r width: w
		)
		timer: duration <Integer> = (
			^TimerFragment duration: duration
		)
		checkbox: text <String> value: v <Boolean | Holder> action: a <[:Boolean | Object]> ^<CheckboxFragent> = (
			^CheckboxFragment text: text value: v action: a
		)
	) : ()
	class RowComposer definitions: fs <List[Fragment]> = SequenceComposer definitions: fs (
	) (
		flexDirection ^<String> = (
			^'row'
		)
		public isKindOfRowComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfRowComposer
		)
		createVisual ^<Alien[HTMLElement]> = (
			| visual = super createVisual. |
			(visual at: 'style') at: 'font-size' put: styleFontSizeText.
			^visual
		)
	) : ()
	class SequenceComposer definitions: fs <List[Fragment]> = Composer new (
		|
			public definitions <List[Fragment]> = fs.
			public color <Color>
			alignItems ::= 'center'.
			childAlignSelf ::= 'center'.
			justifyContent ::= 'flex-start'.
			font ::= 'serif'.
			fontSize ::= styleFontSizeText.
		|
	) (
		public childrenDo: aBlock = (
			definitions do: aBlock
		)
		public crossAxisAlignToStart = (
			alignItems:: 'flex-start'.
			childAlignSelf:: nil
		)
		public crossAxisAlignToCenter = (
			alignItems:: 'center'.
			childAlignSelf:: 'center'
		)
		public crossAxisAlignToEnd = (
			alignItems:: 'flex-end'.
			childAlignSelf:: nil
		)
		public crossAxisStretch = (
			alignItems:: 'stretch'.
			childAlignSelf:: nil
		)
		flexDirection ^<String> = (
			subclassResponsibility
		)
		public mainAxisAlignToStart = (
			justifyContent:: 'flex-start'
		)
		public mainAxisAlignToCenter = (
			justifyContent:: 'center'
		)
		public mainAxisAlignToEnd = (
			justifyContent:: 'flex-end'
		)
		alignFragment: fragment <Fragment> = (
			| cell <Alien[HTMLElement]> |
			cell:: fragment visual.
			(cell at: 'style') at: 'overflow' put: 'auto';
				at: 'align-self' put: childAlignSelf;
				at: 'flex-grow' put: fragment expansibility;
				at: 'flex-shrink' put: fragment compressibility.
			nil = fragment size ifFalse: [
					(cell at: 'style') at: 'flex-basis' put: fragment size printString , 'px'
				]
		)
		createVisual ^<Alien[HTMLElement]> = (
			| container <Alien[HTMLElement]> |
			container:: document createElement: 'div'.
			container at: 'id' put: 'SequenceComposer';
				at: 'contentEditable' put: 'false'.
			(container at: 'style') at: 'overflow' put: 'auto';
				at: 'display' put: 'flex';
				at: 'flex-direction' put: flexDirection;
				at: 'padding-right' put: '2em';
				at: 'align-content' put: alignItems;
				at: 'justify-content' put: justifyContent;
				at: 'font-family' put: font;
				at: 'font-size' put: fontSize.
			nil = color ifFalse: [ color applyToStyle: (container at: 'style') ].
			definitions do: [:fragment <Fragment> |
					fragment parent: self.
					alignFragment: fragment.
					container appendChild: fragment visual
				].
			^container
		)
		updateVisualsFromSameKind: oldFragment <SequenceComposer> ^<Alien[Element]> = (
			| size <Integer> = definitions size. oldVisual <Alien[Element]> = oldFragment visual. |
			
			(* We cannot, in general, know whether the elements of the sequence correlate
    However, if the sequences have the same length they might. *)
			size = oldFragment definitions size ifTrue: [
					
					(* Assume the common case: elements are in 1:1 correspondence. *)
					1 to: size
						do: [:i <Integer> |
							| def = definitions at: i. |
							def parent: self.
							def updateVisualsFrom: (oldFragment definitions at: i).
							alignFragment: def
						].
					color ~= oldFragment color ifTrue: [
							color isNil ifFalse: [ color applyToStyle: (oldVisual at: 'style') ]
						].
					^oldVisual
				].
			
			(* If the sizes differ, the oldFragment was not produced by the same code and we will compute our visual from scratch *)
			^replaceVisual: oldVisual with: visual
		)
	) : ()
	class SinglePageNavigationHistory new = NavigationHistory new (
		(* This class serves the needs of an application where Hopscotch occupies the entire page.

In this case, we leave navigation to the surrounding web browser. 
Nevertheless, we need to interact with this process so that the presenters displayed
are up to date. Hence all navigation involves a navigation history of some sort.

When an existing page is displayed, the callback for web browser navigation uses
the value of its state property as the id to lookup the presenter.
Lookup is done via the method #presenterFor:, which either finds an existing entry in #ids, 
or returns nil. *)
		
	) (
		recordFirst: presenter <Presenter> = (
			(* The popstate event has a null id when navigating all the way back. *)
			
			ids at: presenter put: nil
		)
		public isKindOfSinglePageNavigationHistory ^<Boolean> = (
			^true
		)
		public = other ^<Boolean> = (
			^other isKindOfSinglePageNavigationHistory
		)
		public hash ^<Integer> = (
			^class hash
		)
		public visit: newPresenter = (
			currentVisitSlot = newPresenter ifTrue: [ ^self ].
			
			(* add newPresenter to the web browser's history (except when newPresenter is transient) *)
			newPresenter isTransient ifFalse: [
					nil = currentVisitSlot ifTrue: [ recordFirst: newPresenter ]
						ifFalse: [
							history pushState: (idFor: newPresenter) title: newPresenter title
						]
				].
			
			(* Also do the normal visit: *)
			super visit: newPresenter
		)
		moveHistoryBack = (
			history back
		)
		moveHistoryForward = (
			history forward
		)
	) : ()
	class StaticImageFragment image: i <Alien[Image]> = LeafFragment new (
		|
			public image <Alien[Image]> = i.
		|
	) (
		createVisual = (
			| div img |
			div:: document createElement: 'div'.
			div at: 'id' put: 'StaticImageFragment'.
			(div at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'flex-column';
				at: 'align-items' put: 'center'.
			img:: image cloneNode: false.
			
			(* Not deep *)
			width = -1 ifFalse: [ widthStyle:: width printString , 'px' ].
			height = -1 ifFalse: [ heightStyle:: height printString , 'px' ].
			(img at: 'style') at: 'width' put: widthStyle;
				at: 'height' put: heightStyle;
				at: 'object-fit' put: 'contain'.
			div appendChild: img.
			registerGestures: img.
			^div
		)
		public isKindOfStaticImageFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfStaticImageFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> = (
			| oldVisual = oldFragment visual. |
			oldFragment image ~= image ifTrue: [
					| updatedImage = image cloneNode: false. |
					width = -1 ifFalse: [ widthStyle:: width printString , 'px' ].
					height = -1 ifFalse: [ heightStyle:: height printString , 'px' ].
					(updatedImage at: 'style') at: 'width' put: widthStyle;
						at: 'height' put: heightStyle;
						at: 'object-fit' put: 'contain'.
					oldVisual replaceChild: updatedImage
						replacing: (oldVisual at: 'firstChild').
					registerGestures: updatedImage
				].
			^oldVisual
		)
	) : ()
	class StaticLabelFragment text: t = LeafFragment new (
		|
			textX ::= t.
			font = Font config: fontConfig.
			element <Alien[Element]>
			public color
		|
	) (
		public isKindOfStaticLabelFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfStaticLabelFragment
		)
		public smallFont = (
			(visual at: 'style') at: 'font-size' put: 'smaller'
		)
		public text = (
			^textX
		)
		public bold = (
			font weight: #bold.
			applyStyle: element
		)
		public fontWeight: weight <Symbol> = (
			font weight: weight.
			applyStyle: element
		)
		public italic = (
			font style: #italic.
			applyStyle: element
		)
		public strikethrough = (
			(* TODO: Allow combined decorations *)
			
			font decoration: #linethrough.
			applyStyle: element
		)
		public underline = (
			(* TODO: Allow combined decorations *)
			
			font decoration: #underline.
			applyStyle: element
		)
		public text: newText = (
			textX: newText.
			hasVisual ifTrue: [ visual at: 'textContent' put: textX ]
		)
		visualModified = (
			element isNil ifTrue: [ ^self ].
			applyStyle: element
		)
		applyStyle: element <Alien[HTMLElement]> = (
			element isNil ifTrue: [ ^self ].
			font applyStyle: element.
			nil = color ifFalse: [
					(element at: 'style') setProperty: 'color' to: color asCSSString
				]
		)
		createVisual = (
			| element = document createElement: 'div'. |
			element at: 'id' put: 'StaticLabelFragment'.
			(element at: 'style') at: 'overflow' put: 'hidden';
				at: 'white-space' put: 'pre'.
			element at: 'contentEditable' put: 'false';
				at: 'textContent' put: text.
			applyStyle: element.
			^element
		)
		public fontSize: size <Number> = (
			font size: size.
			applyStyle: element
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| oldVisual = oldFragment visual. |
			oldVisual at: 'textContent' put: text.
			
			(* Re-apply color if it differs from the prior fragment. Mirrors
     the HyperlinkFragment>>updateVisualsFromSameKind: pattern.
     Without this, dynamically-colored labels (e.g. status banners
     that change red/green/grey across renders) keep their original
     CSS color from the first createVisual call because the diff
     reuses the DOM element and the new fragment's color slot is
     never applied. *)
			color ~= oldFragment color ifTrue: [
					color isNil ifFalse: [
							(oldVisual at: 'style') setProperty: 'color' to: color asCSSString
						]
				].
			^oldVisual
		)
	) : ()
	public class Subject onModel: aModel = Object new (
		(* Subjects implement application semantics. 

Subclasses of Subject must implement the method #isMyKind:.
 The implementation is #isMyKind: is formulaic, calling #isKindOfX for whatever type X the subject represents, e.g, for class FooSubject:
 
 isMyKind: other <Subject> ^ <Boolean> = (^isKindOfFooSubject)

By default, subjects are equal if they are of the same kind and have equal models. It is sometimes necessary to override equality. *)
		
		|
			public model = aModel.
			presenterSlot <Presenter>
		|
	) (
		public = anotherSubject ^<Boolean> = (
			^(isMyKind: anotherSubject) and: [ model = anotherSubject model ]
		)
		public createPresenter ^<Presenter> = (
			subclassResponsibility
		)
		public hash ^<Integer> = (
			^model hash
		)
		isMyKind: s <Subject> ^<Boolean> = (
			subclassResponsibility
		)
		public refreshmentSubject ^<Subject> = (
			(* Answer a new subject representing the same thing as the receiver. *)
			
			^self class onModel: model
		)
		public title ^<String> = (
			^self printString
		)
		public presenter ^<Presenter> = (
			presenterSlot isNil ifTrue: [ presenterSlot:: createPresenter ].
			presenterSlot generation < uiGeneration ifTrue: [
					presenterSlot:: createPresenter
				].
			^presenterSlot
		)
	) : ()
	class TextBlockFragment onText: t <Text> subfragments: sfs <List[Fragment]> = TextFragment onText: t (
		(* A fragment representing a compound text . *)
		
		|
			subfragments <List[Fragment]> = sfs.
		|
	) (
		createVisual = (
			| span = document createElement: 'span'. |
			span at: 'id' put: 'TextBlockFragment'.
			text textProperties applyTo: span.
			subfragments do: [:u |
					span insertAdjacentElement: 'beforeEnd' into: u visual
				].
			^span
		)
		public cursorPosition ^<Integer> = (
			| ca sel = window getSelection. focusNode sum <Integer> ::= 0. |
			sel isNil ifFalse: [
					
					(* BOGUS: assumes the block is a flat collection of TextStringFragments *)
					focusNode:: sel at: 'focusNode'.
					ca:: (sel getRangeAt: 0) at: 'commonAncestorContainer'.
					subfragments do: [:sf <Fragment> |
							(sf visual at: 'firstChild') = focusNode ifTrue: [
									^sum + sf cursorPosition
								].
							sum:: sum + (sf visual at: 'textContent') size
						]
				].
			^nil
		)
		public cursorPosition: position <Integer> = (
			| sum <Integer> ::= 0. |
			
			(* BOGUS: assumes the block is a flat collection of TextStringFragments *)
			subfragments do: [:subfragment <Fragment> |
					| index <Integer> |
					index:: position - sum.
					sum:: sum + (subfragment visual at: 'textContent') size.
					position <= sum ifTrue: [
							subfragment cursorPosition: index.
							^self
						]
				]
		)
		public isKindOfTextBlockFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTextBlockFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| span = oldFragment visual. |
			text textProperties applyTo: span.
			subfragments do: [:u |
					span insertAdjacentElement: 'beforeEnd' into: u visual
				].
			^span
		)
	) : ()
	class TextDisplayFragment text: t = LeafFragment new (
		|
			textX ::= t.
		|
	) (
		createVisual = (
			| div = document createElement: 'div'. |
			div at: 'id' put: 'TextDisplayFragment'.
			(div at: 'style') setProperty: 'white-space' to: 'pre-wrap'.
			div at: 'textContent' put: textX.
			^div
		)
		public isKindOfTextDisplayFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTextDisplayFragment
		)
		public smallFont = (
			(visual at: 'style') at: 'font-size' put: 'smaller'
		)
		public text = (
			^textX
		)
		public text: newText = (
			textX: newText.
			hasVisual ifTrue: [ visual at: 'textContent' put: textX ]
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| div = oldFragment visual. |
			div at: 'textContent' put: textX.
			^div
		)
	) : ()
	public class TextFieldFragment new = TextEditorFragment new (
	) (
		createVisual = (
			| editor = super createVisual. |
			^editor
		)
	) : ()
	public class SearchFieldFragment new = TextFieldFragment new (
	) (
		createVisual = (
			| editor = super createVisual. find = document createElement: 'img'. |
			(editor at: 'style') at: 'border-style' put: 'solid';
				at: 'border-width' put: '1px';
				at: 'border-color' put: styleBorderColor;
				at: 'border-radius' put: styleDefaultRadius;
				at: 'background-color' put: 'white'.
			editor addEventListener: 'keydown'
				action: [:event |
					respondToKeyDown: event.
					nil
				].
			(textEditor at: 'style') at: 'line-height' put: '24px';
				at: 'display' put: 'block';
				at: 'outline' put: 0;
				at: 'white-space' put: 'nowrap';
				at: 'fontFamily' put: styleFontFamilySansSerif;
				at: 'font-size' put: styleFontSizeEditor;
				at: 'color' put: 'dimgray';
				at: 'padding-left' put: '8px';
				at: 'min-width' put: '25vw';
				at: 'max-width' put: '80vw';
				at: 'min-height' put: styleTextInputHeight;
				at: 'max-height' put: styleTextInputHeight.
			find at: 'src' put: (findImage yourself at: 'src').
			(find at: 'style') at: 'width' put: styleTextInputHeight;
				at: 'height' put: styleTextInputHeight;
				at: 'cursor' put: 'pointer'.
			find at: 'onclick'
				put: [:event |
					respondToAccept: event.
					nil
				].
			editor appendChild: find.
			^editor
		)
		respondToKeyDown: event <Alien[Event]> = (
			| keyCode <Character> = event at: 'keyCode'. esc <Character> = 27. enter <Character> = 13. |
			keyCode = enter ifTrue: [
					event preventDefault.
					leaveEditState.
					respondToAccept: event
				].
			keyCode = esc ifTrue: [ defaultCancelResponse ]
		)
	) : ()
	public class TextEditorFragment new = LeafFragment new (
		|
			textX <TextFragment | String> ::= ''.
			textEditor <Div>
			public textBeingAccepted <String>
			isInEditState ::= false.
			public changeResponse <[TextEditorFragment]>
			public acceptResponse <[TextEditorFragment]>
			public cancelResponse <[TextEditorFragment]>
			public oldText <TextFragment | String>
		|
	) (
		public cursorPosition ^<Integer> = (
			(* BOGUS. This leads to quirks when cutting and pasting. We really need to get the selection from the browser and identify
the cursor position based on that. But so far that hasn't worked. And we have issues with inserting newlines. *)
			
			| oldString <String> = textX text string. newString <String> = textBeingAccepted. bound <Integer> = newString size min: oldString size. offset <Integer> = -1 max: newString size - oldString size - 1. |
			1 to: bound
				do: [:i <Integer> |
					(oldString at: i) = (newString at: i) ifFalse: [ ^i + offset ]
				].
			^newString size
		)
		registerChangeHandler = (
			changeHandler:: CallBackWrapper wrapping: [:codeMirror :change |
					respondToChange: codeMirror.
					nil
				].
			editor on: 'change' respondToChange: changeHandler wrappedCallback
		)
		public defaultAcceptResponse = (
			setVisualText: textBeingAccepted.
			leaveEditState
		)
		defaultCancelResponse = (
			setVisualText: textX.
			leaveEditState
		)
		public updateEditState = (
			isInEditState ifFalse: [ isInEditState:: true ]
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTextEditorFragment
		)
		public leaveEditState = (
			isInEditState ifTrue: [ isInEditState:: false ]
		)
		respondToCancel = (
			(* confirm: 'Confirm Cancel' ifConfirmed:
		[ *)
			
			nil = cancelResponse ifTrue: [ defaultCancelResponse ]
				ifFalse: [ cancelResponse cull: self ]
			(* ] *)
			
		)
		respondToChange: event <Alien[Event]> = (
			textBeingAccepted:: textEditor at: 'textContent'.
			nil = changeResponse ifFalse: [ changeResponse cull: self cull: event ]
		)
		setVisualText: aText = (
			hasVisual ifTrue: [ setText: aText ]
		)
		public showMessage: message = (
			window alert: message
		)
		public text = (
			^textX
		)
		public text: t = (
			oldText:: textX.
			textX: t.
			setVisualText: textX
		)
		public updateCursor = (
			| sum <Integer> ::= 0. cp <Integer> = textX cursorPosition. |
			textX cursorPosition: cp
		)
		respondToAccept: event <Alien[Event]> = (
			textBeingAccepted:: textEditor at: 'value'.
			nil = acceptResponse ifTrue: [ defaultAcceptResponse ]
				ifFalse: [ acceptResponse cull: self cull: event ]
		)
		setText: t <TextFragment | String> = (
			t isKindOfString ifTrue: [ textEditor at: 'value' put: t ]
				ifFalse: [
					| children = List new. |
					oldText isKindOfString ifFalse: [
							(textEditor at: 'childNodes') forEach: [:n | children add: n ].
							children do: [:n | textEditor removeChild: n ]
						].
					textEditor appendChild: t visual
				]
		)
		createVisual = (
			| frame = document createElement: 'div'. |
			frame at: 'id' put: 'TextEditorFragment'.
			(frame at: 'style') at: 'display' put: 'flex'.
			textEditor:: document createElement: 'input'.
			textEditor at: 'contentEditable' put: 'true'.
			(textEditor at: 'style') at: 'flex' put: 1.
			setText: textX.
			textEditor addEventListener: 'input'
				action: [:event |
					respondToChange: event.
					nil
				].
			frame appendChild: textEditor.
			^frame
		)
	) : ()
	class TextFragment onText: t <Text> = Fragment new (
		(* Abstract supertype of all texts. *)
		
		|
			public text <Text> = t.
		|
	) (
		public cursorPosition: position <Integer> = (
			subclassResponsibility
		)
		public isKindOfTextFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTextFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			subclassResponsibility
		)
	) : ()
	class TextStringFragment onText: t <Text> = TextFragment onText: t (
		(* A formatted string. *)
		
	) (
		public createVisual = (
			| span = document createElement: 'span'. |
			span at: 'id' put: 'TextStringFragment'.
			text textProperties applyTo: span.
			span at: 'textContent' put: text string.
			^span
		)
		public cursorPosition ^<Integer> = (
			| sel = window getSelection. |
			sel isNil ifFalse: [
					^
					(* (visual at: 'firstChild') = (sel at: 'focusNode') ifTrue: [ *)
					(sel getRangeAt: 0) at: 'endOffset'
				].
			
			(* ] *)
			'textStringFragment cursorPosition is nil!' out.
			^nil
		)
		public cursorPosition: position <Integer> = (
			| textNode = visual at: 'firstChild'. range = document createRange. |
			range setStart: textNode to: position;
				setEnd: textNode to: position.
			window getSelection removeAllRanges;
				addRange: range
		)
		public isKindOfTextStringFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTextStringFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			| span = oldFragment visual. |
			text textProperties applyTo: span.
			span at: 'textContent' put: text string.
			^span
		)
	) : (
		public forString: s <String> ^<Instance> = (
			^onText: (TextString forString: s properties: TextProperties new)
		)
		public forString: s <String> properties: tps <TextProperties> ^<Instance> = (
			^onText: (TextString forString: s properties: tps)
		)
	)
	class ToggleComposer collapsedDefinition: collapsed <[Fragment]> expandedDefinition: expanded <[Fragment]> initiallyExpanded: flag <Boolean> = Composer new (
		|
			expandedDefinition <[Fragment]> = expanded.
			collapsedDefinition <[Fragment]> = collapsed.
			public isExpanded <Boolean> ::= flag.
			public expandedPresenter <Fragment>
			public collapsedPresenter <Fragment>
			public contentHolder <Alien[Div]>
			toggleWidget <Alien[Img]>
			public tag <String> ::= ''.
		|
	) (
		public childrenDo: aBlock = (
			nil = collapsedPresenter ifFalse: [ aBlock value: collapsedPresenter ].
			nil = expandedPresenter ifFalse: [ aBlock value: expandedPresenter ]
		)
		public collapse = (
			isExpanded:: false.
			installCollapsedPresenter
		)
		ensureCollapsedPresenter = (
			collapsedPresenter isNil ifTrue: [
					collapsedPresenter:: collapsedDefinition value.
					collapsedPresenter parent: self
				]
		)
		ensureExpandedPresenter = (
			expandedPresenter isNil ifTrue: [
					expandedPresenter:: expandedDefinition value.
					expandedPresenter parent: self
				]
		)
		public expand = (
			isExpanded:: true.
			installExpandedPresenter
		)
		installCollapsedPresenter = (
			ensureCollapsedPresenter.
			installContentVisual: collapsedPresenter visual.
			collapsedPresenter noticeExposure.
			toggleWidget at: 'src' put: (disclosureClosedImage at: 'src').
			(toggleWidget at: 'style') at: 'height' put: styleRowHeight
		)
		installContentVisual: newVisual = (
			contentHolder hasChildNodes ifTrue: [
					| oldVisual = contentHolder at: 'firstChild'. |
					contentHolder replaceChild: newVisual insteadOf: oldVisual
				]
				ifFalse: 
				(* DOM API is stupid; it really replaces old with new *)
				[ contentHolder appendChild: newVisual ]
		)
		installExpandedPresenter = (
			ensureExpandedPresenter.
			installContentVisual: expandedPresenter visual.
			expandedPresenter noticeExposure.
			toggleWidget at: 'src' put: (disclosureOpenImage at: 'src').
			(toggleWidget at: 'style') at: 'height' put: styleRowHeight
		)
		public isKindOfToggleComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfToggleComposer
		)
		public toggle = (
			isExpanded:: isExpanded not.
			isExpanded ifTrue: [ installExpandedPresenter ]
				ifFalse: [ installCollapsedPresenter ]
		)
		public updateToggle: toggleBlock <[Alien[Event]]> = (
			toggleWidget at: 'onclick' put: toggleBlock.
			^toggleWidget
		)
		interactiveToggle = (
			(* A distinct method that can be overridden by HopscotchForCroquet. 
The #toggle method is public, and can be called by other parts of the system. If we override it to publish croquet events, we can get excess events that get propagate to other clients, causing multiple toggles that cancel each other out. In any such case, there needs to be a non-public method that deals exclusively with action directly driven by the user on the same fragment. This method fulfills that purpose. *)
			
			toggle
		)
		createVisual = (
			| toggleDiv <Alien[Div]> = document createElement: 'div'. div <Alien[Div]> = document createElement: 'div'. |
			contentHolder:: document createElement: 'div'.
			contentHolder at: 'id' put: 'ToggleComposerContentHolder'.
			toggleWidget:: document createElement: 'img'.
			updateToggle: [:event |
					interactiveToggle.
					nil
				].
			toggleDiv appendChild: toggleWidget.
			(contentHolder at: 'style') at: 'flex-grow' put: 1;
				at: 'flex-shrink' put: 1.
			(toggleDiv at: 'style') setProperty: 'flex-grow' to: 0;
				setProperty: 'flex-shrink' to: 0.
			toggleWidget at: 'align' put: 'top'.
			isExpanded ifTrue: [ installExpandedPresenter ]
				ifFalse: [ installCollapsedPresenter ].
			div at: 'id' put: 'ToggleComposer'.
			(div at: 'style') at: 'display' put: 'flex';
				at: 'flex-direction' put: 'row'.
			div appendChild: toggleDiv.
			div appendChild: contentHolder.
			^div
		)
		updateVisualsFromSameKind: oldFragment <ToggleComposer> ^<Alien[Element]> = (
			toggleWidget:: oldFragment updateToggle: [:event |
					interactiveToggle.
					nil
				].
			contentHolder:: oldFragment contentHolder.
			isExpanded:: oldFragment isExpanded.
			oldFragment expandedPresenter isNil ifFalse: [
					ensureExpandedPresenter.
					expandedPresenter updateVisualsFrom: oldFragment expandedPresenter
				].
			oldFragment collapsedPresenter isNil ifFalse: [
					ensureCollapsedPresenter.
					collapsedPresenter updateVisualsFrom: oldFragment collapsedPresenter
				].
			isExpanded ifTrue: [ installExpandedPresenter ]
				ifFalse: [ installCollapsedPresenter ].
			^oldFragment visual
		)
	) : ()
	class TaggedSequenceComposer definitions: ts <Sequence[Tagged]> = SequenceComposer definitions: ts (
		(* A sequence that we can intelligently update. *)
		
	) (
		public isKindOfTaggedSequenceComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTaggedSequenceComposer
		)
		updateVisualsFromSameKind: oldFragment <Self> ^<Alien[Element]> = (
			(* In a tagged list, we can either patch the old one to include new things, drop deleted ones and update the contents of existing ones
   recursively, or we can patch the new one by updating the state of pre-existing definitions.
   We do the former so can preserve the existing DOM as much as possible, which is more efficient and helps preserve visual state like scrolling position. *)
			
			| contentMap = Map new. oldVisual = oldFragment visual. |
			definitions do: [:e <Tagged> |
					e parent: self.
					contentMap at: e tag put: e
				].
			oldFragment definitions do: [:op <Tagged> |
					(contentMap includesKey: op tag) ifTrue: [
							(contentMap at: op tag) updateVisualsFrom: op.
							alignFragment: op
						]
				].
			
			(* in any case, remove all children of oldVisual; we want it to be childless before we add all the visuals from the new definitions *)
			1 to: ((oldVisual at: #children) at: #length)
				do: [:i | oldVisual removeChild: (oldVisual at: #firstChild) ].
			
			(* add the visuals of new definitions *)
			definitions do: [:e <Tagged> | oldVisual appendChild: e visual ].
			^oldVisual
		)
	) : ()
	class TaggedColumnComposer definitions: fs <List[Fragment]> = TaggedSequenceComposer definitions: fs (
		crossAxisStretch.
	) (
		flexDirection ^<String> = (
			^'column'
		)
		public isKindOfTaggedColumnComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTaggedColumnComposer
		)
	) : ()
	class TaggedRowComposer definitions: fs <List[Fragment]> = TaggedSequenceComposer definitions: fs (
	) (
		flexDirection ^<String> = (
			^'row'
		)
		public isKindOfTaggedRowComposer ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTaggedRowComposer
		)
		createVisual ^<Alien[HTMLElement]> = (
			| visual = super createVisual. |
			(visual at: 'style') at: 'font-size' put: styleFontSizeText.
			^visual
		)
	) : ()
	public class ZebraDecorator firstColor: color1 secondColor: color2 = Decorator new (
		|
			firstColor ::= color1.
			secondColor ::= color2.
			sequenceDefinition
		|
	) (
		public decorate: aVisual = (
			| odd <Boolean> ::= false. children = aVisual at: 'children'. |
			0 to: (children at: 'length') - 1
				do: [:index |
					| each = children item: index. c <Color> |
					c:: odd ifTrue: [ firstColor ] ifFalse: [ secondColor ].
					assert: [ c isNil not ] message: [ 'nil color!' ].
					c applyToStyle: (each at: 'style').
					odd:: odd not
				].
			^aVisual
		)
	) : (
		public darkerColorFirst = (
			^self firstColor: styleZebraSecondaryColor
				secondColor: styleZebraPrimaryColor
		)
		public lighterColorFirst = (
			^self firstColor: styleZebraPrimaryColor
				secondColor: styleZebraSecondaryColor
		)
	)
	class DownwardRequestDispatcher sender: s = RequestDispatcher sender: s (
		(* Responsible for delivering requests in a fragment hierarchy in the direction from parents to children. Typically created by sending the #sendDown message to a fragment. Unlike the upward dispatcher, the message is delivered to all children who care to receive it rather than to the first one. The children are traversed in some unspecified order (which happens to be depth-first :). *)
		
	) (
		doesNotUnderstand: aMessage = (
			message:: aMessage.
			deliverToChildrenOf: sender
		)
		public deliverToChildrenOf: object <Fragment | HopscotchShell> = (
			object childrenDo: [:each |
					each receiveRequestFrom: self.
					deliverToChildrenOf: each
				]
		)
	) : ()
	class UpwardRequestDispatcher sender: s = RequestDispatcher sender: s (
		(* Responsible for delivering requests inside a fragment hierarchy from children to parents. Typically created by sending the #sendUp message to a fragment and then sending to the result the message to deliver as a request to parents. For example, in a method of a fragment:

	sendUp deleteSlotInPresenter: self.

The message #deleteSlotInPresenter: sent to the instance is catched by the doesNotUnderstand: method of the dispatcher. The dispatcher then walks the chain of parents of the instance sending to each the #receiveRequestFrom: message, searching for one that would return true from the message to indicate acceptance of the request. The argument of the #receiveRequestFrom: message is the dispatcher itself. A parent can communicate with the dispatcher to retrieve and examine the sender, the selector, and/or the arguments of the request.

What exactly constitutes the acceptance and handling of a request is up to each particular parent to define. However, the interpretation common to presenters is to accept a request with the selector understood by the presenter, and process it by sending the selector to the presenter.

By default, a request is delivered to the first (in the bottom-up order) presenter that accepts it, and the delivery finishes. A dispatcher can be flagged as #toAll by sending it this message before asking it to deliver a request. Such a presenter will deliver its requests to all interested parents of the sender.

If none of the parents of a presenter accept a request, an error is signaled by default. However, a dispatcher can be flagged as delivery-optional by sending to it the #deliveryOptional message after creation and before using it to send a request. A delivery-optional dispatcher will silently ignore an undelivered request. Alternatively, the user can provide a dispatcher with an #ifUndelivered: block (again, before using it to send requests). *)
		
		|
			sendToAll <Boolean> ::= false.
			public ifUndelivered <[Object]>
			delivered <Boolean> ::= false.
		|
	) (
		toAll = (
			(* Configure the receiver so that it delivers requests to all parents of the sender, rather than only to the first one that will accept the request. *)
			
			sendToAll:: true
		)
		public deliveryOptional = (
			(* Configure the receiver so that if a request is undelivered, no error is signaled. *)
			
			ifUndelivered: [ ]
		)
		doesNotUnderstand: aMessage = (
			message:: aMessage.
			sendToAll ifTrue: [ deliverToAll ] ifFalse: [ deliverToFirst ].
			^delivered ifTrue: [ sender ]
				ifFalse: [
					nil = ifUndelivered ifFalse: [ ifUndelivered value ]
						ifTrue: [ sender error: 'Undelivered notice' ]
				]
		)
		public deliverToAll = (
			| here <Fragment | HopscotchShell> |
			delivered:: false.
			here:: sender parent.
			[ nil = here ] whileFalse: [
					delivered:: delivered | (here receiveRequestFrom: self).
					here:: here parent
				]
		)
		public deliverToFirst = (
			| here <Fragment | HopscotchShell> |
			delivered:: false.
			here:: sender parent.
			[ nil = here ] whileFalse: [
					(here receiveRequestFrom: self) ifTrue: [ ^delivered:: true ].
					here:: here parent
				]
		)
	) : ()
	class RequestDispatcher sender: s = Object new (
		|
			message <Message>
			sender = s.
		|
	) (
		public arguments ^<Array> = (
			^message arguments
		)
		public selector ^<Symbol> = (
			^message selector
		)
	) : ()
	public class HTMLFragment html: h <String> = LeafFragment new (
		|
			public html <String> = h.
		|
	) (
		public isKindOfHTMLFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfHTMLFragment
		)
		document ^<Alien[Document]> = (
			^DOMParser new parseFromString: html mimeType: 'text/html'
		)
		createVisual = (
			^document at: #body
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			html = oldFragment html ifTrue: [ ^oldFragment visual ].
			^replaceVisual: oldFragment visual with: visual
		)
	) : ()
	public class AmpleforthFragment html: h <String> mapping: m <Map[String, Fragment]> expressions: em <Map[String, String]> = Composer new (
		(* The amplets that this fragment incorporates are its logical children, yielded by childrenDo: below, so the framework's tree propagation (#refresh, #noticeExposure, #hasPendingChanges) traverses into them. This class was formerly a LeafFragment, which cut all three walks off at the document boundary (and whose hasPendingChanges override hid pending edits in embedded editors). *)
		
		|
			public html <String> ::= h.
			public fragmentMapping <Map[String, Fragment]> = m.
			public expressionMapping <Nap[String, String]> = em.
			document_slot <Alien[Document]>
		|
		processChildren.
	) (
		public isKindOfAmpleforthFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfAmpleforthFragment
		)
		domElementsWithClass: klass <String> do: action <[:Alien[Element] | Object]> = (
			| elements = document getElementsByClassName: klass. |
			0 to: (elements at: 'length') - 1
				do: [:index | action value: (elements at: index) ]
		)
		public document ^<Alien[Document]> = (
			document_slot isNil ifTrue: [
					document_slot:: DOMParser new parseFromString: html mimeType: 'text/html'
				].
			^document_slot
		)
		createVisual = (
			^document at: #body
		)
		targetDocument ^<Documents Document> = (
			^fragmentMapping at: 'AmpleforthTargetDocument' ifAbsent: [ ]
		)
		public childrenDo: aBlock <[:Fragment | Object]> = (
			(* Yield the amplet (and mapped) fragments as this fragment's logical
     children (see the class comment above). The framework's tree
     propagation (#refresh, #noticeExposure, #hasPendingChanges — see the
     Fragment class comment) walks the hierarchy through this method. In
     particular, the shell's post-navigation noticeExposure must reach
     embedded amplet presenters: a CodeMirror that received fresh text
     while its DOM was detached (during reconciliation) stays painted
     stale until its exposure-driven refresh repaints it.
     The 'AmpleforthTargetDocument' entry is the host Document — not a
     fragment — and is skipped. *)
			
			fragmentMapping keysAndValuesDo: [:k :v |
					k = 'AmpleforthTargetDocument' ifFalse: [ aBlock value: v ]
				]
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			html = oldFragment html ifTrue: [
					oldFragment fragmentMapping keysAndValuesDo: [:k :v |
							(fragmentMapping includesKey: k) ifTrue: [
									(fragmentMapping at: k) updateVisualsFrom: v
								]
						].
					^oldFragment visual
				].
			^replaceVisual: oldFragment visual with: visual
		)
		recomputeAmplet: expression <String> ^<Fragment> = (
			^expression = nil ifFalse: [ targetDocument evaluateFragment: expression ]
				ifTrue: [
					(StaticLabelFragment text: 'Missing name attribute') color: (Color r: 1
							g: 0
							b: 0)
				]
		)
		processChildren = (
			| amplets <List[Alien[Element]]> = List new. mapped <List[{Alien[Element]. Alien[Element]}]> = List new. |
			
			(* Any DOM nodes that are targets of the mapping need to be identified before any tree mutations. Otherwise, we might find nodes that weren't in the source, but were inserted when the mapping or amplets were processed *)
			fragmentMapping keysAndValuesDo: [:k <String> :v <Fragment> |
					v parent: self.
					domElementsWithClass: k
						do: [:element |
							mapped add: ((Array new: 2) at: 1 put: element;
									at: 2 put: v visual;
									yourself)
						]
				].
			
			(* If we are part of a  document, we need to process amplets as well *)
			targetDocument isNil ifFalse: [
					
					(* collect amplets before modifying the tree, to avoid adding nested amplets to the amplets collection, and being processed by this fragment by mistake.  That's what happens we don't do this and just use #domElementsWithClass: directly. *)
					domElementsWithClass: 'ampleforth' do: [:element | amplets add: element ].
					
					(* Now go thru the amplets and compute their value, inserting the result into the DOM. *)
					amplets do: [:element |
							| expression <String | Nil> = element getAttribute: 'name'. ampletId <String> = element getAttribute: 'ampletId'. priorExpression <String | Nil> = expressionMapping at: ampletId
								ifAbsent: [ ]. priorFragment <Fragment> = fragmentMapping at: ampletId
								ifAbsent: [ ]. currentFragment <Fragment> = fragmentMapping at: ampletId
								put: (priorFragment isNil ifTrue: [ recomputeAmplet: expression ]
									ifFalse: [
										
										(* check if name has changed, if so, update *)
										priorExpression = expression ifTrue: [ priorFragment ]
											ifFalse: [
												(recomputeAmplet: expression) updateVisualsFrom: priorFragment
											]
									]). |
							expressionMapping at: ampletId put: expression.
							currentFragment parent: self.
							element at: #style put: 'display: inline-flex'.
							element appendChild: currentFragment visual
						]
				].
			
			(* Non-amplet nodes in the mapping are attached to the DOM here *)
			mapped do: [:element | (element at: 1) appendChild: (element at: 2) ].
			visual.
			document_slot:: nil
		)
	) : (
		public html: h <String> mapping: m <Map[String, Fragment]> = (
			^html: h mapping: m expressions: Map new
		)
	)
	public class TaggedHolderComposer withContent: definition <Fragment | [Fragment]> tag: t <Symbol> = HolderComposer withContent: definition (
		(* This class is used to wrap fragments that lack a tag method, so they can be used in tagged sequences (columns or rows). *)
		
		|
			public tag <Symbol> = t.
		|
	) (
	) : ()
	public class WindowFragment openSubject: s <Subject> = Fragment new (
		(* WIP: This fragment allows an entire HopscotchWindow to be embedded within the UI (i.e., nested windows). This in turn can be used to support a tiled window system, which is especially useful when running on the web, where browser restrictions do not allow multiple windows on shared state. *)
		
		|
			public initialSubject <Subject> ::= s.
			public embeddedWindow <EmbeddedHopscotchWindow>
		|
	) (
		public isKindOfWindowFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfWindowFragment
		)
		createVisual = (
			| element = document createElement: 'div'. |
			embeddedWindow:: EmbeddedHopscotchWindow into: element
				openSubject: initialSubject.
			initialSubject:: nil.
			^element
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			initialSubject = oldFragment initialSubject ifTrue: [
					embeddedWindow currentPresenter updateVisualsFrom: oldFragment embeddedWindow currentPresenter.
					^oldFragment visual
				].
			^replaceVisual: oldFragment visual with: visual
		)
	) : (
		public new = (
			^openSubject: HomeSubject new
		)
	)
	public class AudioPlayerFragment uri: u <String> = LeafFragment new (
		(* An Audio player LeafFragment that shows an Audio dom element with the uri *)
		
		|
			public uri <String> = u.
			public title ::= ''.
		|
	) (
		public isKindOfAudioPlayerFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfAudioPlayerFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			uri = oldFragment uri ifTrue: [ ^oldFragment visual ].
			^replaceVisual: oldFragment visual with: visual
		)
		createVisual = (
			| audioel = document createElement: 'audio'. |
			audioel at: 'controls' put: true;
				at: 'title' put: title;
				at: 'src' put: uri.
			^audioel
		)
	) : ()
	public class VideoPlayerFragment uri: u <String> = LeafFragment new (
		(* An Video player LeafFragment that shows an Video dom element with the uri *)
		
		|
			public uri <String> = u.
			public title ::= ''.
		|
	) (
		public isKindOfVideoPlayerFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfVideoPlayerFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			uri = oldFragment uri ifTrue: [ ^oldFragment visual ].
			^replaceVisual: oldFragment visual with: visual
		)
		createVisual = (
			(* example:
      <video controls width="250">
        <source src="/media/cc0-videos/flower.webm" type="video/webm" />

        <source src="/media/cc0-videos/flower.mp4" type="video/mp4" />
      </video> *)
			
			| videoel = document createElement: 'video'. source = document createElement: 'source'. |
			videoel appendChild: source.
			videoel at: 'title' put: title.
			at: 'controls' put: true.
			source at: 'src' put: uri.
			^videoel
		)
	) : ()
	class MediaCreatorFragment type: t <Symbol> name: fn <String> registry: mr <Map[String, Blob]> width: w <String> = Fragment new (
		|
			public type <Symbol> = t.
			public fileName <String> = fn.
			registry <Map[String, Blob]> = mr.
			public width <String> = w.
			public holder <HolderComposer> = HolderComposer withContent: computeHolderContent.
		|
	) (
		createVisual = (
			^holder visual
		)
		public isKindOfMediaCreatorFragment ^<Boolean> = (
			^true
		)
		isMyKind: other <Fragment> ^<Boolean> = (
			^other isKindOfMediaCreatorFragment
		)
		updateVisualsFromSameKind: oldFragment <MediaCreatorFragment> ^<Alien[Element]> = (
			type ~= oldFragment type ifTrue: [
					^replaceVisual: oldFragment visual with: visual
				].
			fileName ~= oldFragment fileName ifTrue: [
					^replaceVisual: oldFragment visual with: visual
				].
			holder updateVisualsFrom: oldFragment holder.
			^oldFragment visual
		)
		computeHolderContent = (
			| f = registry at: fileName ifAbsent: [ ^BlankFragment new ]. uri = blobURIFor: f. |
			^computeHolderContentsFrom: uri
		)
		public setFile: f <Alien[File]> = (
			(* Do nothing by default, since the file is already known; this is a hook subclasses may override *)
			
		)
		computeHolderContentsFrom: uri <String> = (
			(type startsWith: #image) ifTrue: [
					^(ImageElementFragment uri: uri width: width) name: fileName
				].
			(type startsWith: #audio) ifTrue: [
					^(AudioPlayerFragment uri: uri) title: fileName
				].
			(type startsWith: #video) ifTrue: [
					^(VideoPlayerFragment uri: uri) title: fileName
				]
		)
	) : (
		public type: t <Symbol> name: fn <String> registry: mr <Map[String, Blob]> ^<Instance> = (
			^type: t name: fn registry: mr width: '600px'
		)
	)
	public class ImageElementFragment uri: u <String> width: w <String> = LeafFragment new (
		(* A very vanilla image element that just takes an image uri without fanfare. 
  TODO: integrate with StaticImageFragment *)
		
		|
			public uri <String> = u.
			public width <String> = w.
			public name ::= ''.
		|
	) (
		public isKindOfImageElementFragment ^<Boolean> = (
			^true
		)
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfImageElementFragment
		)
		updateVisualsFromSameKind: oldFragment <Fragment> ^<Alien[Element]> = (
			uri = oldFragment uri ifTrue: [ ^oldFragment visual ].
			^replaceVisual: oldFragment visual with: visual
		)
		createVisual = (
			| imageel = document createElement: 'img'. |
			(imageel at: 'style') at: 'width' put: width.
			imageel at: 'src' put: uri.
			imageel at: 'name' put: name.
			^imageel
		)
	) : (
		public uri: u <String> ^<Instance> = (
			^uri: u width: '600px'
		)
	)
	public class TimerFragment duration: milliseconds <Integer> = LeafFragment new (
		|
			public duration <Integer> = milliseconds.
			public timeLeft <Integer> ::= duration.
			timerId
			updateFunction = [
				timeLeft:: timeLeft - 1.
				visual at: #innerHTML put: timeLeft
			].
		|
	) (
		isMyKind: f <Fragment> ^<Boolean> = (
			^f isKindOfTimerFragment
		)
		public isKindOfTimerFragment ^<Boolean> = (
			^true
		)
		createVisual = (
			| timer = document createElement: 'div'. |
			timer at: 'id' put: 'timer'.
			timer at: #innerHTML put: duration.
			timerId:: js global setTimeout: updateFunction every: 1000.
			^timer
		)
		updateVisualsFromSameKind: oldFragment <TimerFragment> ^<Alien[Element]> = (
			| oldTimer = oldFragment visual. |
			timeLeft:: oldFragment timeLeft.
			js global clearTimeout: oldFragment timeId.
			timerId:: js global setTimeout: updateFunction every: 1000.
			^oldTimer
		)
	) : ()
	public class AIColors new = Object new (
		(* Shared colour palette for the user/assistant/error turn bubbles —
 both the inline ChatPresenter and the chat-as-document path in
 AI_IDE_Support read these so the two views stay visually consistent. *)
		
	) (
		public assistantTurnBackground ^<String> = (
			^'#edf2ee'
		)
		public assistantTurnBorder ^<String> = (
			^'#b0c8b4'
		)
		public userTurnBackground ^<String> = (
			^'#eef4fb'
		)
		public userTurnBorder ^<String> = (
			^'#b8d4ec'
		)
		public errorTurnBackground ^<String> = (
			^'#fdecea'
		)
		public errorTurnBorder ^<String> = (
			^'#d68682'
		)
		public errorText ^<Color> = (
			^Color r: 0.8 g: 0 b: 0
		)
	) : ()
	public class AIChatSetupSubject onModel: providerClass <Class> = Subject onModel: providerClass (
		(* Subject for the initial chat setup screen where the user enters
 their API key and chooses a model. The Subject's model is the
 provider *class* (e.g. AnthropicProvider) — not an instance, since
 the instance is what startChat will construct from the key+model
 the user types here. The class name is used to derive a per-provider
 localStorage key so each provider's key is remembered independently. *)
		
		|
			public apiKey <String> ::= ''.
			public modelName <String> ::= 'claude-sonnet-4-6'.
			public errorMessage <String | UndefinedObject>
		|
		
		(* Best-effort restore of the API key. localStorage may be unavailable
	   (private browsing, embedded contexts); on any failure we just leave
	   apiKey as ''. *)
		[
			apiKey:: js localStorage getItem: storageKey.
			apiKey isNil ifTrue: [ apiKey:: '' ]
		] on: Error do: [:e | ].
	) (
		storageKey ^<String> = (
			(* Per-provider key so switching between Anthropic and Gemini doesn't
	   clobber the other's stored API key. *)
			
			^'ns_ai_apikey_' , model name
		)
		public providerClass ^<Class> = (
			^model
		)
		public createProvider = (
			^model apiKey: apiKey model: modelName
		)
		public createSession: provider ^<Session> = (
			^Session provider: provider tools: {}
		)
		public startChat ^<ChatSubject | UndefinedObject> = (
			(* Validate, persist the key, build a session, and return a ChatSubject
	   the caller can navigate to. Returns nil (and sets errorMessage) if
	   the form is incomplete — caller checks for nil before navigating. *)
			
			| provider session <Session> |
			apiKey isEmpty ifTrue: [
					errorMessage:: 'Please enter an API key.'.
					^nil
				].
			[ js localStorage setItem: storageKey to: apiKey ] on: Error do: [:e | ].
			provider:: createProvider.
			session:: createSession: provider.
			^newChatSubjectFor: session
		)
		public newChatSubjectFor: session <Session> ^<ChatSubject> = (
			^ChatSubject onModel: session
		)
		public title ^<String> = (
			^'AI Chat Setup'
		)
		public createPresenter = (
			^AIChatSetupPresenter onSubject: self
		)
		public isKindOfAIChatSetupSubject ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfAIChatSetupSubject
		)
	) : ()
	public class AIChatSetupPresenter onSubject: s = Presenter onSubject: s (
		(* Presenter for the AIChatSetupSubject. Renders the API-key + model entry
 form, and on submit invokes subject startChat which (if validation
 passes) returns a ChatSubject we navigate to via enterSubject:.

 keyRevealed gates whether the API-key editor is rendered. Default:
 revealed when subject apiKey is empty (first-time setup), concealed
 when it's already non-empty (a key was loaded from localStorage —
 don't put it on screen by default in case the user navigates back
 here later or screen-shares). The user can click Reveal/Hide to
 toggle. *)
		
		|
			keyEditor
			keyToggle
			modelEditor
			keyRevealed <Boolean> ::= s apiKey isEmpty.
		|
	) (
		definition = (
			^column: {helpSection. row: {(label: 'AI Chat Setup') bold. filler. helpButton. dropDownMenu: [
							actionsMenu
						]. }. mediumBlank. label: 'Enter your API key to start a chat session.'. label: 'The key is stored in your browser''s localStorage.'. mediumBlank. row: {(label: 'API Key: ') bold. elastic: apiKeyField. }. mediumBlank. row: {(label: 'Model: ') bold. elastic: modelField. }. mediumBlank. errorArea. row: {filler. button: 'Start Chat'
						action: [ respondToStart ]. }. }
		)
		actionsMenu = (
			^menuWithLabelsAndActions: {{'Inspect Presenter'. [
					respondToInspectPresenter
				]. }. }
		)
		respondToInspectPresenter = (
		)
		public helpText ^<Fragment> = (
			^textDisplay: 'Use this page to configure access to an AI provider. Enter your API key in the API Key field. The key is stored in your browser''s localStorage, so you only need to enter it once. Enter the model name in the Model field, then press Start Chat.'
		)
		apiKeyField = (
			(* The API-key editor is wrapped in a ToggleComposer so the key
	   only appears on screen when the toggle is expanded. The toggle's
	   *initial* state on first render is governed by keyRevealed.

	   On subsequent re-renders, ToggleComposer's updateVisualsFromSame-
	   Kind: overrides the new toggle's initiallyExpanded with the OLD
	   toggle's current isExpanded (preserves user-toggled state). To
	   force the toggle closed (on editor-accept or on Start Chat), we
	   keep a slot reference and explicitly call collapse on the old
	   toggle BEFORE updateGUI:; the subsequent re-render's diff sees
	   the old toggle as collapsed and propagates that state. *)
			
			keyToggle:: collapsed: [ keyConcealedRow ]
				expanded: [ keyRevealedEditor ]
				initiallyExpanded: keyRevealed.
			^keyToggle
		)
		keyConcealedRow = (
			^row: {label: '••••••••'. filler. }
		)
		keyRevealedEditor = (
			(* Built lazily by the ToggleComposer when (and only when) the
	   user expands it. changeResponse keystroke-syncs to the subject
	   so the typed key survives a collapse/expand cycle. acceptResponse
	   collapses the toggle (mutating the OLD toggle's state so the
	   next render's diff inherits closed) and pushes keyRevealed to
	   false for the next fresh render in a different presenter. *)
			
			keyEditor:: codeMirror: subject apiKey.
			keyEditor changeResponse: [:frag | subject apiKey: frag textBeingAccepted ].
			keyEditor acceptResponse: [:frag |
					updateGUI: [
							subject apiKey: frag textBeingAccepted.
							keyToggle isNil ifFalse: [ keyToggle collapse ].
							keyRevealed:: false
						]
				].
			^keyEditor
		)
		modelField = (
			(* Dropdown when the current provider class can list models (cached
	   from a prior refresh or via the hardcoded static fallback); falls
	   back to a freeform CodeMirror editor when the list is empty —
	   first-time setup for a provider whose cache hasn't been populated
	   yet (notably OpenAI-compatible: empty staticFallbackModels until
	   the user runs a refresh against a configured server). Both paths
	   surface a refresh button so the user can populate the cache
	   without first creating a chat doc. *)
			
			| instance entries |
			
			(* Delegate to subject createProvider so providers with extra
	   constructor arguments (e.g. OpenAICompatibleProvider's baseUrl)
	   get them threaded in by the subject without this base presenter
	   needing to know about them. *)
			instance:: subject createProvider.
			entries:: instance availableModels.
			entries isEmpty ifTrue: [ ^freeformModelFieldFor: instance ]
				ifFalse: [ ^dropdownModelFieldFor: instance entries: entries ]
		)
		dropdownModelFieldFor: instance entries: entries = (
			| currentLabel |
			modelEditor:: nil.
			currentLabel:: instance displayNameFor: subject modelName.
			^row: {(label: currentLabel) bold. smallBlank. dropDownMenu: [
						menuWithLabelsAndActions: (entries collect: [:m <String> |
									{instance displayNameFor: m. [ updateGUI: [ subject modelName: m ] ]. }
								])
					]. smallBlank. modelRefreshButton: instance. }
		)
		freeformModelFieldFor: instance = (
			(* Freeform CodeMirror + refresh button. Clicking refresh
	   populates the cache against the provider's API and the next
	   render of modelField promotes to the dropdown path. *)
			
			^row: {elastic: codeMirrorModelField. smallBlank. modelRefreshButton: instance. }
		)
		codeMirrorModelField = (
			(* Freeform CodeMirror editor for typing a model id manually. *)
			
			modelEditor:: codeMirror: subject modelName.
			modelEditor changeResponse: [:frag |
					subject modelName: frag textBeingAccepted
				].
			^modelEditor
		)
		modelRefreshButton: instance = (
			(* Trigger a fresh /v1/models (or equivalent) fetch against
	   provider `instance`, persist to the cache, and re-render so the
	   surrounding modelField promotes to a dropdown if entries were
	   discovered. *)
			
			^(imageButton: refreshImage
				action: [
					instance refreshAvailableModels then: [:list |
							updateGUI: [ ].
							list
						]
						onError: [:err | err printString out ]
				]
				size: styleButtonSize) toolTip: 'Refresh model list'
		)
		errorArea = (
			subject errorMessage isNil ifTrue: [ ^blank: 0 ].
			^(label: subject errorMessage) color: aiColors errorText
		)
		respondToStart = (
			(* Re-read the editors before delegating to the subject (defensive —
	   change response should already have synced, but a missed
	   notification would silently send the previous draft). keyEditor is
	   only present when the key field is revealed; if concealed, trust
	   subject apiKey (which was last synced when the user clicked Hide
	   or when the presenter was created from localStorage state).
	   If startChat succeeds, navigate to the new ChatSubject; on
	   validation failure it returns nil and writes errorMessage which
	   the next render shows. Also conceal the key as a side effect of
	   success so any back-navigation to a cached presenter lands on
	   the hidden state. *)
			
			| chatSubject <ChatSubject | UndefinedObject> |
			keyEditor isNil ifFalse: [ subject apiKey: keyEditor textBeingAccepted ].
			
			(* modelEditor is nil when modelField rendered as a dropdown —
	   subject modelName is kept in sync by the menu actions, so there
	   is nothing to re-read here. *)
			modelEditor isNil ifFalse: [
					subject modelName: modelEditor textBeingAccepted
				].
			updateGUI: [ chatSubject:: subject startChat ].
			chatSubject isNil ifFalse: [
					
					(* Collapse the old toggle so its isExpanded:false propagates
		   to any cached-presenter re-render after back-navigation
		   (ToggleComposer's updateVisualsFromSameKind: copies from
		   the old fragment's state, not from initiallyExpanded:). *)
					keyToggle isNil ifFalse: [ keyToggle collapse ].
					keyRevealed:: false.
					enterSubject: chatSubject
				]
		)
		public isKindOfAIChatSetupPresenter ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfAIChatSetupPresenter
		)
	) : ()
	public class ChatSubject onModel: s <Session> = Subject onModel: s (
		(* Subject for a chat conversation. The Subject's model is an AIAccess
 Session, which owns the actual API messages and tool list. ChatSubject
 layers per-UI state on top: the in-progress draft, the waiting flag
 (true while a request is in flight, used to swap the status presenter
 between "…thinking…" and the model picker), and a transient
 errorMessage shown after a failed turn. *)
		
		|
			public draft <String> ::= ''.
			public waiting <Boolean> ::= false.
			public errorMessage <String | UndefinedObject>
		|
	) (
		public session ^<Session> = (
			^model
		)
		public messages ^<List> = (
			^session displayMessages
		)
		public sendDraft ^<Alien[Promise] | UndefinedObject> = (
			(* Legacy path: send whatever is currently in draft. The new input
	   editor uses sendText: instead (see comment there for why). Kept so
	   external callers (programmatic chats) can still send-by-draft. *)
			
			| text <String> |
			text:: draft.
			text isEmpty ifTrue: [ ^nil ].
			draft:: ''.
			waiting:: true.
			errorMessage:: nil.
			^session sendMessage: text
		)
		public sendText: text <String> ^<Alien[Promise] | UndefinedObject> = (
			(* Send a literal text — used by the input editor's accept path so the
	   send does not depend on subject draft, which could be raced to ''
	   by CodeMirror's change event when the editor is cleared. *)
			
			text isEmpty ifTrue: [ ^nil ].
			draft:: ''.
			waiting:: true.
			errorMessage:: nil.
			^session sendMessage: text
		)
		public markComplete = (
			waiting:: false
		)
		public markError: msg <String> = (
			waiting:: false.
			errorMessage:: msg
		)
		public clearHistory = (
			session clearHistory.
			draft:: ''.
			errorMessage:: nil
		)
		public title ^<String> = (
			^'Chat'
		)
		public createPresenter = (
			^ChatPresenter onSubject: self
		)
		public isKindOfChatSubject ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfChatSubject
		)
		public sendText: text <String> attachments: docs <List> ^<Alien[Promise] | UndefinedObject> = (
			(* Like sendText: but forwards document attachments to the session.
	   docs is a List of { filename <String>. content <String> } tuples.
	   sendText: is unchanged and remains the normal no-attachment path. *)
			
			text isEmpty ifTrue: [ ^nil ].
			draft:: ''.
			waiting:: true.
			errorMessage:: nil.
			^session sendMessage: text attachments: docs
		)
	) : ()
	public class ChatStatusPresenter onSubject: s = Presenter onSubject: s (
		(* The status block above the input editor. While a request is in flight
 (subject waiting = true) shows "…thinking…" and the current model;
 otherwise shows a model picker dropdown so the user can swap models
 between turns without losing history. The picker is intentionally
 hidden mid-flight to avoid switching providers/models inside a
 tool-use loop. *)
		
	) (
		definition = (
			subject waiting ifTrue: [
					^column: {(label: '…thinking…') italic. (label: 'Model: ' , currentModelName) color: (Color r: 0.5
								g: 0.5
								b: 0.5). }
				].
			^modelPicker
		)
		currentModelName ^<String> = (
			| provider |
			provider:: subject session provider.
			^provider displayNameFor: provider model
		)
		modelPicker = (
			| provider |
			provider:: subject session provider.
			^row: {label: 'Model: ' , currentModelName , ' '. dropDownMenu: [
						menuWithLabelsAndActions: (provider availableModels collect: [:m <String> |
									{provider displayNameFor: m. [ updateGUI: [ provider model: m ] ]. }
								])
					]. smallBlank. modelRefreshButtonFor: provider. }
		)
		modelRefreshButtonFor: provider = (
			(* Manual refresh of this provider's model-list cache. Pulls a fresh
	   list from the provider's API, persists to localStorage, and
	   triggers an updateGUI: so the dropdown re-renders against the new
	   cache. Failure is logged to console and the dropdown stays on the
	   old list. *)
			
			^(imageButton: refreshImage
				action: [
					provider refreshAvailableModels then: [:list |
							updateGUI: [ ].
							list
						]
						onError: [:err | err printString out ]
				]
				size: styleButtonSize) toolTip: 'Refresh model list'
		)
		public isKindOfChatStatusPresenter ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfChatStatusPresenter
		)
	) : ()
	public class ChatInputPresenter onSubject: s = Presenter onSubject: s (
		(* The CodeMirror editor below the messages area. On accept (Enter/submit)
 captures the text, clears the editor, and routes the send through
 subject sendText: — the Promise resolution updates the waiting flag
 via markComplete / markError:. *)
		
		|
			inputEditor
		|
	) (
		definition = (
			inputEditor:: codeMirror: subject draft.
			
			(* Sync draft on each keystroke so it survives presenter refreshes. *)
			inputEditor changeResponse: [:frag | subject draft: frag textBeingAccepted ].
			inputEditor acceptResponse: [:frag | respondToSend ].
			^column: {inputEditor. }
		)
		respondToSend = (
			(* Capture text locally before clearing/updateGUI so the value isn't
	   raced to '' by CodeMirror's change event firing on text:''. Clear
	   and leaveEditState happen BEFORE updateGUI so the re-render replaces
	   the already-clean editor rather than a fresh one whose JS visual
	   keeps isInEditState true. *)
			
			| promise <Alien[Promise] | UndefinedObject> text <String> |
			text:: inputEditor textBeingAccepted.
			text isEmpty ifTrue: [ ^self ].
			inputEditor text: ''.
			inputEditor leaveEditState.
			updateGUI: [ promise:: subject sendText: text ].
			promise isNil ifTrue: [ ^self ].
			promise then: [:reply | updateGUI: [ subject markComplete ] ]
				onError: [:err | updateGUI: [ subject markError: err printString ] ]
		)
		public isKindOfChatInputPresenter ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfChatInputPresenter
		)
	) : ()
	public class ChatPresenter onSubject: s = Presenter onSubject: s (
		(* Top-level presenter for a chat conversation. Composes three sub-areas:

   messagesArea  scrollable transcript of prior turns (built from
                 subject messages — a List of {role. text} pairs).
   statusFragment  the "thinking" indicator / model picker
                   (delegated to ChatStatusPresenter so it can refresh
                   independently of the messages area).
   inputFragment   the CodeMirror input editor + send wiring
                   (delegated to ChatInputPresenter).

 Splitting the status and input into their own presenters lets the
 chat-as-document path in AI_IDE_Support reuse them by stacking
 dedicated thinking/input ampletes around the document body. *)
		
	) (
		definition = (
			^column: {helpSection. headingBar. mediumBlank. elastic: messagesArea. mediumBlank. statusFragment. inputFragment. }
		)
		headingBar = (
			^row: {(label: 'Chat') bold. filler. button: 'Clear'
					action: [ updateGUI: [ subject clearHistory ] ]. helpButton. dropDownMenu: [
						actionsMenu
					]. }
		)
		statusFragment = (
			^ChatStatusPresenter onSubject: subject
		)
		inputFragment = (
			^ChatInputPresenter onSubject: subject
		)
		actionsMenu = (
			^menuWithLabelsAndActions: {{'Inspect Presenter'. [
					respondToInspectPresenter
				]. }. }
		)
		respondToInspectPresenter = (
		)
		public helpText ^<Fragment> = (
			^textDisplay: 'Chat with the configured AI provider.

Type a message in the input area at the bottom and submit it to send. The conversation history is shown above; press Clear to start a new conversation.

Just above the input there is a status block: while a request is in flight it shows ''…thinking…''; otherwise it shows the current model with a dropdown to switch. Available models (Anthropic):
  - Opus 4.7 — most capable; best for hard refactors and multi-step tool use; most expensive and highest latency.
  - Sonnet 4.6 — balanced default; good for most code lookup and editing.
  - Haiku 4.5 — fastest and cheapest; best for quick navigation and short questions.

Switching models preserves the conversation history — the next turn just goes to the new model with the full prior transcript as context. The first turn after a switch pays a one-time cache miss for the system prompt (Anthropic''s prompt cache is keyed by model); subsequent turns on the new model cache normally.

The picker is hidden while a request is in flight, to avoid switching in the middle of a tool-use loop.'
		)
		messagesArea = (
			| fragments <List> |
			fragments:: List new.
			subject messages do: [:msg <Array> |
					fragments add: (messageFragment: msg).
					fragments add: smallBlank
				].
			subject errorMessage isNil ifFalse: [
					fragments add: ((label: 'Error: ' , subject errorMessage) color: aiColors errorText)
				].
			fragments isEmpty ifTrue: [
					fragments add: (label: 'Send a message to start a conversation.') italic
				].
			^column: fragments
		)
		public isKindOfChatPresenter ^<Boolean> = (
			^true
		)
		isMyKind: other ^<Boolean> = (
			^other isKindOfChatPresenter
		)
		messageFragment: msg <Array> = (
			(* msg is a two-element {role <String>. text <String>} pair, as built
	   by the provider's displayMessagesFromMessages:. The role determines
	   the colour and label; the text is rendered with white-space:pre-wrap
	   so newlines and indentation in code-bearing replies survive. *)
			
			| role <String> text <String> labelText <String> bg <String> border <String> fontStyle <String> colors |
			colors:: outer HopscotchForHTML5 aiColors.
			role:: msg at: 1.
			text:: msg at: 2.
			role = 'user' ifTrue: [
					labelText:: 'You'.
					bg:: colors userTurnBackground.
					border:: colors userTurnBorder.
					fontStyle:: 'italic'
				]
				ifFalse: [
					labelText:: 'Assistant'.
					bg:: colors assistantTurnBackground.
					border:: colors assistantTurnBorder.
					fontStyle:: 'normal'
				].
			^html: '<div style="display:flex; flex-direction:row; align-items:flex-start; border:1px solid ' , border , '; border-radius:6px; padding:8px 12px; margin:4px 0; background-color:' , bg , ';">' , '<div style="min-width:5em; max-width:5em; padding-right:1em; text-align:right; flex-shrink:0;"><strong>' , labelText , '</strong></div>' , '<div style="flex:1; min-width:0;"><span style="white-space:pre-wrap; font-style:' , fontStyle , ';">' , text , '</span></div></div>'
		)
	) : ()
	lazy public voiceController = VoiceController recognizer: (window at: #webkitSpeechRecognition)
		transcript: transcript
		editor: currentHopscotchWindow.
	lazy public aiColors = AIColors new.
	lazy private window = js global.
	lazy JSObject = js global at: 'Object'.
	lazy private body = document at: 'body'.
	lazy private history = window at: 'history'.
	lazy private fontConfig = FontConfig new.
	lazy public DOMParser = js global at: #DOMParser.
	public CodeMirror = (
		^window at: 'CodeMirror'
	)
	deferAction: action
	(* Save the scrollPosition for the current presenter *)
	 = (
		deferredContentQueue add: action.
		deferredContentQueue size = 1 ifTrue: [ nextFrameDo: [ nextDeferredAction ] ]
	)
	nextDeferredAction = (
		| action = deferredContentQueue removeFirst. |
		deferredContentQueue size > 0 ifTrue: [ nextFrameDo: [ nextDeferredAction ] ].
		action value
	)
	nextFrameDo: action <[Object]>
	(* return how far the top level display is scrolled *)
	 = (
		(window at: 'requestAnimationFrame') isUndefined ifTrue: [
				Timer after: 200 do: action.
				^self
			].
		window requestAnimationFrame: [:time1 <Float> |
				window requestAnimationFrame: [:time2 <Float> |
						window requestAnimationFrame: [:time3 <Float> |
								action value.
								nil
							]
					]
			]
	)
	computeContentForMenu: menuSupplier <[Menu]> ^<Alien[Div]> = (
		| dropDownContent = document createElement: 'div'. |
		(dropDownContent at: 'style') at: 'backgroundColor'
			put: styleMenuBackgroundColor;
			at: 'position' put: 'absolute';
			at: 'z-index' put: 10;
			at: 'padding-top' put: '8px';
			at: 'padding-bottom' put: '8px';
			at: 'border' put: styleMenuBorderColor , ' solid 1px';
			at: 'border-radius' put: styleDefaultRadius;
			at: 'box-shadow' put: '0px 0px 15px ' , styleMenuShadowColor;
			at: 'display' put: 'inline-block';
			at: 'outline' put: 0;
			at: 'cursor' put: 'default'.
		menuSupplier value do: [:menuItem <MenuItem | Symbol> |
				| itemContent <Alien[Element]> |
				itemContent:: contentFor: menuItem within: dropDownContent.
				dropDownContent appendChild: itemContent
			].
		^dropDownContent
	)
	public accept16px
	(* We can detect whether we are in the PWA semi-reliably.
 The code below indicates whether we are in the PWA (as currently configured to use the 'minimal-ui' display option. Likewise, if we choose the 'standalone' option for the PWA. Similarly 

((js global at: #window) matchMedia:  ' (display-mode: browser) ') at: #matches.

says if we are in the browser.  The difficulty is when we are in full screen mode, these answer false (at least on Chromium).  It isn't just a matter of not choosing the #fullscreen option in PWA manifest; if we choose full screen at run time, it dynamically changes the answers. So we might be able to get the same vfuel to choose to show the right controls based on whether it runs as a PWA or not. So the answer is only reliable as long as we don't run full screen. 
It looks like we can ensure that it never opens in fullscreen mode, based on the manifest. It looks like it does not recall its last status. That is mostly ok, as we only need this to work on startup.

Another possible technique is to use the following JS

navigator.getInstalledRelatedApps().then(relatedApps => {
  return relatedApps.some(app => app.id === 'YOUR_PWA_ID');

but that's async, so tricky and tiresome.

Ultimately, we aren't using this method because the navigation controls carry over when switching from the web browser to the app (say, when installing or updating the PWA) and vice versa). We need something more dynamic. *)
	 = (
		^images accept16px
	)
	public backImage = (
		^images backImage
	)
	public cancel16px = (
		^images cancel16px
	)
	public clearImage = (
		^images clearImage
	)
	public disclosureClosedImage = (
		^images disclosureClosedImage
	)
	public disclosureOpenImage = (
		^images disclosureOpenImage
	)
	public downloadImage
	(* a drop handler for a sequence of files. Centralizes the task of extracting the event file data and feeds said data to the provided closure, blk, along with the event position, for custom processing. *)
	 = (
		^images downloadImage
	)
	public dropDownImage = (
		^images dropDownImage
	)
	public findImage = (
		^images findImage
	)
	public forwardImage = (
		^images forwardImage
	)
	public helpImage = (
		^images helpImage
	)
	public historyImage = (
		^images historyImage
	)
	public homeImage = (
		^images homeImage
	)
	public peekingeye1610 = (
		^images peekingeye1610
	)
	public refreshImage = (
		^images refreshImage
	)
	private document = (
		document_slot isNil ifTrue: [ document_slot:: window at: 'document' ].
		^document_slot
	)
	updateAllWindows: action <[Object]> = (
		| priorWindow <HopscotchShell> |
		currentHopscotchWindow currentPresenter setScrollPosition.
		action value.
		uiGeneration:: uiGeneration + 1.
		priorWindow:: currentHopscotchWindow.
		priorWindow updateDisplay.
		windowList do: [:w <HopscotchShell> |
				w = priorWindow ifFalse: [ w updateDisplay ]
			].
		currentHopscotchWindow:: priorWindow
	)
	setToplevelScrollPosition: pos <Number> = (
		(body at: #parentNode) at: #scrollTop put: pos
	)
	toplevelScrollPosition ^<Number> = (
		^(body at: #parentNode) at: #scrollTop
	)
	public Window ^<HopscotchWindow class> = (
		^useSurroundingNavigation ifTrue: [ HopscotchWindow ]
			ifFalse: [ EmbeddedHopscotchWindow ]
	)
	runningInPWA ^<Boolean> = (
		^((js global at: #window) matchMedia: '(display-mode: minimal-ui)') at: #matches
	)
	contentFor: menuItem <MenuItem | Symbol> within: dropDownContent ^<Alien[Element]> = (
		| entry separator <Alien[Element]> |
		menuItem = #separator ifTrue: [
				separator:: document createElement: 'hr'.
				(separator at: 'style') at: 'height' put: '1px';
					at: 'background-color' put: styleBorderColor;
					at: 'border' put: 'none';
					at: 'margin-left' put: styleMenuInset;
					at: 'margin-right' put: styleMenuInset.
				^separator
			].
		entry:: document createElement: 'div'.
		entry at: 'textContent' put: menuItem first.
		(entry at: 'style') at: 'color' put: styleDefaultInterfaceTextColor;
			at: 'font-family' put: styleFontFamilySansSerif;
			at: 'font-size' put: styleFontSizeMenu;
			at: 'padding-left' put: styleMenuInset;
			at: 'padding-right' put: styleMenuInset;
			at: 'height' put: styleMenuItemHeight;
			at: 'line-height' put: styleMenuItemHeight;
			at: 'white-space' put: 'nowrap'.
		entry addEventListener: 'mouseover'
			action: [:event |
				(entry at: 'style') at: 'background-color' put: '#C8C8C8'.
				nil
			];
			addEventListener: 'mouseout'
				action: [:event |
					(entry at: 'style') at: 'background-color' put: '#F6F6F6'.
					nil
				].
		addMenuClickListener: menuItem to: entry.
		^entry
	)
	public blobURIFor: file <Alien[File]> ^<String> = (
		^(window at: #URL) createObjectURL: file
	)
	public onDrop: e <Alien[DragEvent]> do: blk <[:List[JSFile] :Point | Object]> = (
		| files = (e at: #dataTransfer) at: #files. pos = Point x: (e at: #clientX)
			y: (e at: #clientY). fs <List[JSFile]> = List new. |
		0 to: (files at: #length) - 1 do: [:i <Integer> | fs add: (files at: i) ].
		blk value: fs value: pos
	)
	showMenu: menu <Alien[Div]> forShell: s <HopscotchShell> inVisual: v <Visual> = (
		| vbr = v getBoundingClientRect. |
		v appendChild: menu.
		(menu at: 'style') at: 'position' put: 'absolute';
			at: 'left' put: ((window at: #scrollX) + (vbr at: 'left')) asString , 'px';
			at: 'top' put: ((window at: #scrollY) + (vbr at: 'top')) asString , 'px';
			at: 'width' put: (menu at: 'offsetWidth') asString , 'px'.
		menu at: 'tabIndex' put: 0.
		menu at: 'onblur'
			put: [:event |
				s closeActiveMenu.
				nil
			].
		menu focus.
		s activeMenu: menu.
		s activeMenuParent: v
	)
	showMenu: menu <Alien[Div]> forFragment: m <DropDownMenuFragment> = (
		| s <HopscotchShell> = m shell. v <Visual> = m visual. vbr = v getBoundingClientRect. |
		v appendChild: menu.
		(menu at: 'style') at: 'position' put: 'absolute';
			at: 'left' put: ((window at: #scrollX) + (vbr at: 'left')) asString , 'px';
			at: 'top' put: ((window at: #scrollY) + (vbr at: 'top')) asString , 'px';
			at: 'width' put: (menu at: 'offsetWidth') asString , 'px'.
		menu at: 'tabIndex' put: 0.
		menu at: 'onblur'
			put: [:event |
				m removeContentFromShell: s.
				nil
			].
		menu focus.
		s activeMenu: menu.
		s activeMenuParent: v
	)
	clearCurrentMenu = (
		currentHopscotchWindow activeMenuBlurred
	)
	addMenuClickListener: menuItem <MenuItem | Symbol> to: entry <Alien[HTMLElement]> = (
		entry addEventListener: 'click'
			action: [:event |
				event stopPropagation.
				currentHopscotchWindow activeMenuBlurred.
				menuItem last value.
				nil
			]
	)
	public mikeImage = (
		^images mikeImage
	)
) : ()