HopscotchForHTML5.ns

Newspeak3
'Root'
class HopscotchForHTML5 usingPlatform: p images: is ducts: ds (* :exemplar: platform hopscotch *) = (
(* 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.
	
(* 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 window_slot
	private document_slot
	JSObject_slot
    DOMParser_slot
	private body_slot
	private history_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.
 *)
        private fontConfig_slot
	public core = self. (* Polymorphic with HopscotchForBrazil *)
	public fragments = self. (* Polymorphic with HopscotchForBrazil *)
    public homeSubjectClass ::= HomeSubject.
    public useSurroundingNavigation <Boolean> ::= p isKindOfPlatformWithElectron not.
    
 (* Re-export *)   
    public ducts = ds.
    
	  (* Images *)
    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 = LeafFragment (
) (
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 <Holder> value: v <Boolean | Holder> action: a <[:Boolean]> = LeafFragment (
    |
    text <String> ::= t.
    action <[:Boolean]> = a.
    holder <Holder>
    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
)
writeInput: v = (
     holder isNil ifFalse: [         
         holder value: v.
     ].
     action isNil ifFalse: [
         action value: v.
     ].
)
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: 'oninput' 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.
)
extractInput = (
  ^checked:: checkbox at: 'checked'.
)
updateVisualsFromSameKind: oldFragment <Fragment> ^ <Alien[Element]> = (
    checkbox:: oldFragment visual.
    checked:: checkbox at: 'checked'.
    checkbox at: 'oninput' put: inputHandler.
   ^checkbox
)
inputHandler ^ <[:Alien | Boolean]> = (
  ^[:event | 
           ('super input handler running with value' , extractInput printString) out.
            writeInput: extractInput not.
            false.
        ].
)
) : (
)
class ColorPickerFragment value: v <String | Holder> action: a <[:String]> = LeafFragment (
    |
    action <[:String]> = 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]> = LeafFragment (
    |
    action <[:String]> = 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]> = LeafFragment (
    |
    text <String> ::= t.
    items <List[String]> = i.
    action <[:Boolean]> = 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 (
    |
    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]> = LeafFragment (
    |
    text <String> ::= t.
	group <String> = g.
    action <[:Boolean]> = 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 = BlankFragment (
    |
    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 (
    |
    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 = (
    |
    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 = Style(
    backgroundColor:: Color gray: 0.97.
    foregroundColor:: Color gray: 0.17.
    cornerRadius:: 5.
) (
) : (
)
class ButtonFragment label: l action: a = LeafFragment (
    |
	public label = l.
    public enabled ::= true.
	action = a.
    style <ButtonStyle> = ButtonStyle new.
    |
) (
public isKindOfButtonFragment ^ <Boolean> = (
	^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfButtonFragment
)
createVisual = (
    |
    button = document createElement: 'button'.
    |
    button
        appendChild: (document createTextNode: label);
		at: 'onclick' put: [:event | action value. false];
		at: 'disabled' put: enabled not;
        at: 'contentEditable' put: 'false';
		yourself.

    applyStyle: button.

    ^button
)
updateVisualsFromSameKind: oldFragment <ButtonFragment>  ^ <Alien[ButtonElement]> = (
    | oldVisual <Alien[Element]> = oldFragment visual.|
    oldVisual 
        at: 'onclick' put: [:event | action value. false];
        at: 'disabled' put: enabled not.
    oldFragment label ~= label ifTrue: [
        oldVisual replaceChild: (document createTextNode: label) oldChild: (oldVisual at:  'firstChild')
    ].
   ^oldVisual
)
) : (
)
class TimePickerFragment value: v <String | Holder> action: a <[:String]> = LeafFragment (
    |
    action <[:String]> = 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]> = (
|
	public callback <[:T :S]> ::= h.
|
) (
public wrappedCallback = (
 ^[:a1 :a2 | callback value: a1 value: a2]
)
) : (
)
class CanvasFragment withExtent: e = LeafFragment (
	|
	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]> = (
	(* 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]> = (
	alien addEventListener: 'mousedown' action: 
		[:event | onMouseDown value: (event at: 'offsetX') @ (event at: 'offsetY'). nil].
)
public mouseMovedAction: onMouseMoved <[:Point]> = (
	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 (
|
    public editor <Alien[CodeMirror]>
	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 updateEditState = (
	lastChangeWasSynthetic ifTrue: [lastChangeWasSynthetic:: false. ^self].
	
	isInEditState ifFalse:
		[
        visual.		
		useEditControls ifTrue: [
			(counterfactualBar at: 'style') 
				at: 'opacity' put: '1.0'.
		].
		isInEditState:: true
		].
)
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 leaveEditState = (
	isInEditState ifTrue:
		[
		useEditControls ifTrue: [
			(counterfactualBar at: 'style')
				at: 'opacity' put: '0.0'.		
		].
	    removeMessages.		        
		isInEditState:: false.
		]
)
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
)
acceptFromKeydown: event <Alien> = (
  respondToAccept: event
)
cancelFromKeydown = (
  respondToCancel
)
respondToKeyDown: event <Alien[Event]> = (
	| 
	key <Character> = event at: 'key'. 
    (* customary on mac, does not work on windows *)
	metaPressed <Boolean> = event at: 'metaKey'.
    (* works on windows *)
    ctrlPressed <Boolean> = 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.
)
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';
			at: 'pointer-events' put: 'auto'.
		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';
			at: 'pointer-events' put: 'auto'.
		cancel at: 'onclick' put:
			[:event | respondToCancel. nil].
		counterfactualBar appendChild: cancel.
		container appendChild: counterfactualBar.
	].

	frame:: document createElement: 'div'.
	frame at: 'id' put: 'CodeMirrorFragment'.
	(frame at: 'style')
		at: 'display' put: 'flex';
		at: 'flex-direction' put: 'row'.
	useEditControls ifTrue: [		
		(frame at: 'style') at: 'margin-top' put: '-20px'.
	].
	container appendChild: frame.

	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.
	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
)
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
)
) : (
)
class ColorDecorator color: c <Color> = Decorator (
| 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 = Fragment () (
) : (
)
public class Decorator = (
(* 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 (|
	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 DropDownMenuFragment menu: ms image: img <Image> alignment: side <Symbol> = ImageButtonFragment  (
(*
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 <[Tuple[Symbol | Tuple[String, []]]]> = ms. (* Skip formal menu structure for now*)
	alignment <String>  = side asString.
    image = img.
    action = [].
    width = styleButtonSize.
    height = styleButtonSize.
    isActive ::= false.
	|
) (
public isKindOfDropDownMenuFragment ^ <Boolean> = (
	^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfDropDownMenuFragment
)
removeContent ^ <Alien[Element]> = (
    isActive: false.
	^visual removeChild: (visual at: 'lastChild')
)
updateContent ^ <Alien[Element]> = (
    | menu <Alien[Div]> = computeContentForMenu: menuSupplier. |
    isActive: true.
	showMenu: menu forShell: shell inVisual: visual.
    ^menu.
)
updateVisualsFromSameKind: oldFragment <Fragment> ^ <Alien[Element]> = (
| oldVisual = oldFragment visual. img = oldVisual at: 'firstChild'.|
    img at: 'onclick' put: [:event | action value. false].
    oldVisual addEventListener: 'click' action: [:event | 
      isActive 
        ifTrue: [isActive: false. shell closeActiveMenu] 
        ifFalse: [updateContent]. 
      nil
    ].
   ^oldVisual
)
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
)
clickHandler = (
  ^[:event | 
      isActive 
        ifTrue: [isActive: false. shell closeActiveMenu] 
        ifFalse: [updateContent]. 
      nil
    ].
)
) : (
public menu: ms  <[Tuple[Symbol | Tuple[String, []]]]> ^ <Instance> = (
   ^menu: ms image: dropDownImage alignment: #right
)
public menu: ms  <[Tuple[Symbol | Tuple[String, []]]]> alignment: side <Symbol> ^ <Instance> = (
   ^menu: ms image: dropDownImage alignment: side
)
public menu: ms  <[Tuple[Symbol | Tuple[String, []]]]> 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 = super ToolbarPresenter (
) (
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
)
public goForward = (
	| oldPresenter <Presenter> |
	currentHopscotchWindow:: self.
	navigator goForward.
	oldPresenter:: navigator current.
	displayPresenter: oldPresenter refreshmentPresenter.
)
public goBack = (
	| oldPresenter <Presenter> |
	currentHopscotchWindow:: self.
	navigator goBack.
	oldPresenter:: navigator current.
	displayPresenter: oldPresenter refreshmentPresenter.
)
selectPastIndex: i <Integer> = (
	navigator goToPastIndex: i.
	displayPresenter: navigator current
)
selectFutureIndex: i <Integer> = (
	navigator goToFutureIndex: i.
	displayPresenter: navigator current
)
listenForBackButton = (  
  (* do nothing *)
)
) : (
public openSubject: s = (
	^into: body openSubject: s
)
)
class FileChooserFragment allowMultiples: b <Boolean> = Fragment (
  | public allowMultiples <Boolean> = b. |
) (
public chooseFileList:  blk <[:List[Alien[File]]]> = (
  | 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]]> = (
  allowMultiples ifTrue: [Error signal: 'This chooser may choose multiple files'].
  chooseFileList: [:files <List[Alien[File]]> | blk value: (files at: 1)]
)
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
)
)
class Fragment = (
(*
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.

*)
    |
	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 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 = (|
	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 (|
	contentSource <Fragment | [Fragment]> ::= definition.
	actualContent <Fragment>
|) (
public childrenDo: aBlock <[:Fragment]> = (
	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 = Subject onModel: nil (
) (
public createPresenter = (
	^HomePresenter onSubject: self
)
public isKindOfHomeSubject ^ <Boolean> = (
  ^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfHomeSubject
)
) : (
)
class HopscotchShell (* :exemplar: fail *) = (
(*
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 goHome = (
	atHome ifFalse:
		[enterSubject: homeSubject]
)
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 *)
    (* 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 class HopscotchWindow into: container openSubject: s = HopscotchShell (
	listenForBackButton.
	container appendChild: toolbarHolder.
	container appendChild: contentHolder.
    toolbarHolder appendChild: ToolbarPresenter new visual.
	enterSubject: s.
) (
class ToolbarPresenter = 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
)
toolbarItems ^ <Array[Fragment]>  = (
 ^{filler. historyButton. smallBlank. homeButton. smallBlank. refreshButton. smallBlank. helpButton. smallBlank}
)
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
)
) : (
)
public displayPresenter: p = (
	super displayPresenter: p.
	setTitle: p title.
)
public isKindOfHopscotchWindow = (
  ^true
)
setTitle: t = (
	document at: 'title' put: t.
)
showHistory = (
  (* Make showHistory accessible to nested classes *)
  super showHistory
)
public exit = (
  eraseHistory.
  body removeChild: toolbarHolder.
  body removeChild: contentHolder.
  windowList remove: self.
)
) : (
public openSubject: s = (
	^into: body openSubject: s
)
)
class HyperlinkFragment label: l action: a = LeafFragment (
    |
	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).
	(anchor at: 'style')
		at: 'textDecoration' put: 'none'; (* No underline *)
		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 (|
	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 = LeafFragment (
(* A button displayed as an image; or an image that acts as a button. *)
|
	public action <[]>
	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 = Fragment (
    |
    properties_slot <Map[Symbol, Object]>
    |

) (
public properties ^ <Map[Symbol, Object]> = (
  properties_slot isNil ifTrue: [properties_slot:: Map new].
  ^properties_slot
)
public defaultHandler ^  <[: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]> = ( 
  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]> = ( 
  properties at: #onMouseEnter put: blk.
)
public onMouseMove: blk <[:Object]> = ( 
  properties at: #onMouseMove put: blk.
)
public onMouseDown: blk <[:Object]> = ( 
  properties at: #onMouseDown put: blk.
)
public onMouseOut: blk <[:Object]> = ( 
  properties at: #onMouseOut put: blk.
)
public onMouseOver: blk <[:Object]> = ( 
  properties at: #onMouseOver put: blk.
)
public onMouseUp: blk <[:Object]> = ( 
  properties at: #onMouseUp put: blk.
)
public onTouchCancel: blk <[:Object]> = ( 
  properties at: #onTouchCancel put: blk.
)
public onTouchEnd: blk <[:Object]> = ( 
  properties at: #onTouchEnd put: blk.
)
public onTouchMove: blk <[:Object]> = ( 
  properties at: #onTouchMove put: blk.
)
public onTouchStart: blk <[:Object]> = ( 
  properties at: #onTouchStart put: blk.
)
public onWheel: blk <[: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]> = ( 
  ^properties at: #onWheel ifAbsent: [defaultHandler]
)
public onTouchStart ^ <[:Object]> = ( 
  ^properties at: #onTouchStart ifAbsent: [defaultHandler]
)
public onTouchMove ^ <[:Object]> = ( 
  ^properties at: #onTouchMove ifAbsent: [defaultHandler]
)
public onTouchEnd ^ <[:Object]> = ( 
  ^properties at: #onTouchEnd ifAbsent: [defaultHandler]
)
public onTouchCancel ^ <[:Object]> = ( 
  ^properties at: #onTouchCancel ifAbsent: [defaultHandler]
)
public onMouseUp ^ <[:Object]> = ( 
  ^properties at: #onMouseUp ifAbsent: [defaultHandler]
)
public onMouseOver ^ <[:Object]> =  (
  ^properties at: #onMouseOver ifAbsent: [defaultHandler]
)
public onMouseOut ^ <[:Object]> = ( 
  ^properties at: #onMouseOut ifAbsent: [defaultHandler]
)
public onMouseMove ^ <[:Object]> = ( 
  ^properties at: #onMouseMove ifAbsent: [defaultHandler]
)
public onMouseEnter ^ <[:Object]> = ( 
  ^properties at: #onMouseEnter ifAbsent: [defaultHandler]
)
public onMouseDown ^ <[:Object]> = ( 
  ^properties at: #onMouseDown ifAbsent: [defaultHandler]
)
public onClick ^ <[:Object]> = ( 
  ^properties at: #onClick ifAbsent: [defaultHandler]
)
public heightStyle ^ <String> = ( 
  ^properties at: #heightStyle ifAbsent: ['auto']
)
) : (
)
class MultiPageNavigationHistory = NavigationHistory (
(*
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:
*)
| history_slot <EventHistory> |
) (
class EventHistory = (
	|
	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.
)
) : (
)
recordFirst: presenter <Presenter> = (
	(* The popstate event has a null id when navigating all the way back. *)
	ids at: presenter put: nil.
)
public visit: newPresenter = (
	newPresenter isTransient ifFalse:
		[nil = currentVisitSlot
			ifTrue: [recordFirst: newPresenter]
			ifFalse: [history pushState: (idFor: newPresenter) title: newPresenter title]].
    super visit: newPresenter.
)
public goForward = (
	isFutureEmpty ifFalse:
		[(isTransient: currentVisitSlot) ifFalse:
			[past addLast: currentVisitSlot].
        history moveForward.
		currentVisitSlot:: future removeFirst]
)
public goBack = (
	isPastEmpty ifFalse:
		[(isTransient: currentVisitSlot) ifFalse:
			[future addFirst: currentVisitSlot].
        history moveBack.
		currentVisitSlot:: past removeLast]
)
erasePast = (
    history erasePast.
	past:: List new.
)
eraseFuture = (
    history eraseFuture.
	future:: List new.
)
history = (
  history_slot isNil ifTrue: [history_slot:: EventHistory new].
  ^history_slot
)
nextId ^ <Number> = (
 (* provide access for EventHistory *)
  ^super nextId
)
) : (
)
class NavigationHistory = (
(* 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:
*)
	|
	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 goBack = (
	isPastEmpty ifFalse:
		[(isTransient: currentVisitSlot) ifFalse:
			[future addFirst: currentVisitSlot].
		currentVisitSlot:: past removeLast]
)
public goForward = (
	isFutureEmpty ifFalse:
		[(isTransient: currentVisitSlot) ifFalse:
			[past addLast: currentVisitSlot].
		currentVisitSlot:: future removeFirst]
)
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.
	].
)
) : (
)
class PaddedFrameComposer content: c offsets: o = Composer (|
	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 (
(*
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]
		]
)
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> action: block <[]> = (
	^ButtonFragment label: label action: block
)
canvas: extent <Point> = (
	^CanvasFragment withExtent: extent
)
checkbox: text <String> value: v <Holder> action: a <[:Boolean]> = (
	^CheckboxFragment text: text value: v action: a
)
colorPicker: value <Holder> action: a <[:Boolean]> = (
	^ColorPickerFragment value: value action: a
)
datePicker: value <Holder> action: a <[:Boolean]> = (
	^DatePickerFragment value: value action: a
)
picker: text <String> items: i <List[String]> action: a <[:String]> = (
	^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]> = (
	^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]> = (
	^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
)
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 <[]> = (
	^ImageButtonFragment new
        image: image;
        action: block
)
imageButton: image <Image> action: block <[]> 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 <[]> = (
	^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 <[]> = (
	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 <Tuple[Symbol | Tuple[String, []]]> ^ <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 
)
) : (
)
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 (|
	public definitions <List[Fragment]> = fs.
	public color <Color>
	protected alignItems ::= 'center'.
	protected childAlignSelf ::= 'center'.
	protected justifyContent ::= 'flex-start'.
	protected font ::= 'serif'.
	protected 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 = NavigationHistory (
(*
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.
)
) : (
)
class StaticImageFragment image: i <Alien[Image]> = LeafFragment (
    |
	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 (
    |
	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.
  ^oldVisual
)
) : (
)
public class Subject onModel: aModel = (
(*
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 (|
	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 = TextEditorFragment (|
|) (
createVisual = (
        | editor = super createVisual. |
        ^editor
    )
) : (
)
public class SearchFieldFragment = TextFieldFragment (|
|) (
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 = LeafFragment (|
	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 (
(*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 (
|
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] (* DOM API is stupid; it really replaces old with new *)
		ifFalse: [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.
  contentHolder isNil ifTrue: ['nil contentHolder during update', out].
  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 (|
	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 <[]>
	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 = (
	|
	message <Message>
	sender = s.
	|
) (
public arguments ^<Array> = (
	^message arguments
)
public selector ^<Symbol> = (
	^message selector
)
) : (
)
public class HTMLFragment html: h <String> = LeafFragment (
	|
	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]> = LeafFragment  (
(* The superclass is LeafFragment. However, AmpleforthFragment. The amplets that this fragment incorporates are its children. Some restructuring is needed.*)
	|
    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]]> = (
	| 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: [].
)
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 (
(* 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 (
  (* 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 (
  (* 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]> = Fragment (
	|
    public type <Symbol> = t.
    public fileName <String> = fn.
    registry <Map[String, Blob]> = mr.
	public holder <HolderComposer> = HolderComposer withContent: computeHolderContent.
	|
) (
createVisual = (
  ^holder visual
)
public isKindOfMediaCreatorFragment ^ <Boolean> = (
  ^true
)
isMyKind: other <Fragment> ^ <Boolean> = (
  ^other isKindOfMediaCreatorFragment
)
computeHolderContentsFrom: uri <String> = (
  (type startsWith: #image) ifTrue: [^(ImageElementFragment uri: uri) name: fileName].
  (type  startsWith: #audio) ifTrue: [^(AudioPlayerFragment uri: uri) title: fileName].
  (type  startsWith: #video) ifTrue: [^(VideoPlayerFragment uri: uri) title: fileName].
)
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 *)
)
) : (
)
public class ImageElementFragment uri: u <String> = LeafFragment (
  (* A very vanilla image element that just takes an image uri without fanfare. 
  TODO: integrate with StaticImageFragment
  *)
  |
    public uri <String> = u.
    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: '600px'.
    imageel at: 'src' put: uri.
    imageel at: 'name' put: name.
    ^imageel
  )
) : (
)
public CodeMirror = (
  ^window at: 'CodeMirror'.
)
deferAction: action = (
	deferredContentQueue add: action.
	deferredContentQueue size = 1 ifTrue:
		[nextFrameDo: [nextDeferredAction]].
)
nextDeferredAction = (
	| action = deferredContentQueue removeFirst. |
	deferredContentQueue size > 0 ifTrue:
		[nextFrameDo: [nextDeferredAction]].
	action value.
)
nextFrameDo: action <[]> = (
	(* Our goal is to run the argument after images have been loaded and rendered. window.requestAnimationFrame runs the callback *before* the next frame. We register another callback in the callback so the first deferred action runs *after* the next frame. We register *that* callback in another RAF callback to let new images added from a deferred block load and render before the next deferred block runs. RAF is also a relatively new feature, so simply schedule a timer if it is not available. *)
	(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
)
showMenu: menu <Alien[Div]> 
		forShell: s <HopscotchShell> 
		inVisual: v <Visual> = (
    v appendChild: menu.
	positionMenu: menu at: (v at: 'offsetTop') forShell: s.
	menu focus.
    s activeMenu: menu.
    s activeMenuParent: v.
)
positionMenu: menu <Alien[Div]> at: y <Float> forShell: s <HopscotchShell> = (
	|
	rightInset <Float> = 20.
    x <Float> = menu at: 'offsetLeft'.
	w <Float> = menu at: 'offsetWidth'.
    left <Float>
    maxLeft <Float>
    top <Float>
	|

	(* Determine optimal placement *)
    maxLeft:: (window at: 'innerWidth') - w - rightInset.
	left:: x > maxLeft ifTrue: [maxLeft] ifFalse: [x].
	top:: y < 0 ifTrue: [0] ifFalse: [y].
    (menu at: 'style') 
        at: 'position' put: 'absolute';
        at: 'left' put: left asString, 'px';
        at: 'top' put: top asString, 'px';
        at: 'width' put: w asString, 'px'.
    
    menu at: 'tabIndex' put: 0.
    menu at: 'onblur' put: [:event | s closeActiveMenu. nil].
)
public accept16px = (^images accept16px)
public backImage = (^images backImage)
public cancel16px = (^images cancel16px)
public clearImage = (^images clearImage)
public disclosureClosedImage = (^images disclosureClosedImage)
public disclosureOpenImage = (^images disclosureOpenImage)
public downloadImage = (^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 window = (
  window_slot isNil ifTrue: [window_slot:: js global].
  ^window_slot
)
private document = (
  document_slot isNil ifTrue: [document_slot:: window at: 'document'].
  ^document_slot
)
JSObject = (
  JSObject_slot isNil ifTrue: [JSObject_slot:: js global at: 'Object'].
  ^JSObject_slot
)
private body = (
  body_slot isNil ifTrue: [body_slot:: document at: 'body'].
  ^body_slot
)
private history = (
  history_slot isNil ifTrue: [history_slot:: window at: 'history'].
  ^history_slot
)
private fontConfig = (
  fontConfig_slot isNil ifTrue: [fontConfig_slot:: FontConfig new].
  ^fontConfig_slot
)
public DOMParser = (
  DOMParser_slot isNil ifTrue: [DOMParser_slot:: js global at: #DOMParser].
  ^DOMParser_slot
)
updateAllWindows: action <[Object]> = (
  | priorWindow <HopscotchShell> |
  (* Save the scrollPosition for the current presenter  *)
  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> = (
  (* return how far the top level display is scrolled *)
   ^(body at: #parentNode) at: #scrollTop
)
public Window ^ <HopscotchWindow class> = (
  ^useSurroundingNavigation ifTrue: [HopscotchWindow] ifFalse: [EmbeddedHopscotchWindow]
)
runningInPWA ^ <Boolean> = (
(*
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.

*)
  ^ ((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
)
addMenuClickListener: menuItem < MenuItem | Symbol> to: entry <Alien[HTMLElement]> = (
	entry addEventListener: 'click' action:
		[:event | menuItem last value. nil].
)
public blobURIFor: file <Alien[File]> ^ <String> = (

  ^(window at: #URL) createObjectURL: file
)
public onDrop: e <Alien[DragEvent]> do: blk <[:List[JSFile] :Point]> = (
  (* 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. *)
   | 
   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.
)
) : (
)