AmpleforthEmbedder.ns

Newspeak3
'Root'
class AmpleforthEmbedder usingPlatform: p ide: webIDE  = (
(*
Ampleforth is designed to support live literate programming. It supports embedding Newspeak code inside the text of a normal web page.  This code pertains to an earlier version of Ampleforth. See the comments in Ampleforth.ns for more details about the difference between the two.

Ampleforth documents can be produced by editing HTML in any tool.  Use the Ampleforth application to run such pages stand alone. One can interactively edit and run such documents in the Newspeak IDE (see the HopscotchWebIDE module).

Ampleforth is a character in 1984 whose role is to convert works of Oldspeak literature into Newspeak. He's a literary editor conversant in Newspeak.

Copyright 2014-2017 Google Inc.
Copyright 2022-2024 Gilad Bracha.
*)
|
	private List = p collections List.
	private Color = p graphics Color.
	private ObjectMirror = p mirrors ObjectMirror.
	private ClassMirror = p mirrors ClassMirror.
	private Subject = p hopscotch core Subject.
	private Presenter = p hopscotch core Presenter.
	private TextEditorFragment = p hopscotch fragments TextEditorFragment.
	private Gradient = p hopscotch Gradient.
	private EmbeddedHopscotchWindow = p hopscotch core EmbeddedHopscotchWindow.
	private ClassSubject = webIDE browsing ClassSubject.    
	private EvaluationViewState = webIDE browsing EvaluationViewState.
	private EvaluatorSubject = webIDE browsing EvaluatorSubject.
	private HomeSubject = webIDE browsing HomeSubject.        
	private ObjectSubject = webIDE browsing ObjectSubject.
    private IDEWindow = webIDE browsing IDEWindow.
    private Document = webIDE documents Document.
    
    EmbeddedIDEWindow = IDEWindow mixinApply: EmbeddedHopscotchWindow.
	namespace = webIDE namespacing Root.
	browsing = webIDE browsing.
	document = p js global at: 'document'.
	platformMirror = ObjectMirror reflecting: p.
 | 
 namespace at: #AmpleforthEmbedder put: self class
 ) (
class ErrorPresenter onSubject: s = Presenter onSubject: s (
) (
public definition ^ <Fragment> = (
	^label: subject errorMessage
)
public isKindOfErrorPresenter ^ <Boolean> = (
  ^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfErrorPresenter
)
) : (
)
class ErrorSubject onModel: s <String> = Subject onModel: s (
|
	public errorMessage = s.
|) (
public createPresenter ^ <ErrorPresenter> = (
	^ErrorPresenter onSubject: self
)
isMyKind: other ^ <Boolean> = (
  ^other isKindOfErrorSubject
)
public isKindOfErrorSubject ^ <Boolean> = (
  ^true
)
) : (
)
domElementsWithClass: klass <String> do: action <[:Alien[Element]]> = (
	| elements = document getElementsByClassName: klass. |
	0 to: (elements at: 'length') - 1 do:
		[:index | action value: (elements at: index)].
)
evaluateSubject: se <String> ^ <Subject> = (
(* Takes a string representing a unary block and evaluates it with
	browsing as its argument.  The result should be a Subject, which gets
	returned. In other words, the string should contain an expression of type
   [:BrowsingForHTML | Subject]
*)
	| blk |
	blk:: platformMirror
		evaluate: (withoutNbsp: se)
		ifCompilerError: [:e | ^ErrorSubject onModel: 'compile-time error: ', e printString]
		ifError: [:e | ^ErrorSubject onModel: 'runtime error: ', e printString].
		^blk value: browsing
)
topLevelClassOf: om <ObjectMirror> ^ <ClassDeclarationMirror> = (
	| klass ::= om getClass mixin declaration. |
	[klass mixin enclosingClass isNil] whileFalse: [klass:: klass enclosingClass].
	^klass
)
withoutNbsp: string = (
	('a' at: 1) isKindOfInteger
		ifTrue:
			[ | bytes = ByteArray withAll: string. |
			1 to: bytes size do: [:index | (bytes at: index) = 160 ifTrue: [bytes at: index put: 32]].
			^bytes asString]
		ifFalse:
			[ | nonbreakingSpace = String fromRune: 160.
			space = String fromRune: 32. |
			^string replaceAll: nonbreakingSpace with: space]
)
populateNamespace = (
 | platformClass <ClassMirror> = topLevelClassOf: platformMirror. |
	namespace at: #Browsing put: (ClassMirror reflecting: self Browsing) mixin declaration.
	namespace at: platformClass name put: platformClass.
	platformClass slots do: [:s <SlotMirror> | | klass <ClassMirror> o <ObjectMirror> |
		o:: platformMirror getSlot: s name.
		klass:: topLevelClassOf: o.
		namespace at: klass name put: klass.
		].
)
public processEvaluators = (
	domElementsWithClass: 'evaluator' do:
		[:element |
		| 
		expression = element getAttribute: 'expression'. 
		om <ObjectMirror> = platformMirror. 
		es = EvaluatorSubject onModel: (EvaluationViewState onModel: om).
		|
        es initialSource: expression.
		es evaluateLive: expression.
		EmbeddedIDEWindow
			into: element
			openSubject: es].
)
public processAmplets = (
    | targetDocument <Document> =  Document named: 'dummy' contents: ''. |
    domElementsWithClass: 'ampleforth' do: [:element |
      | 
      name <String | Nil> = element getAttribute: 'name'.
      expr <String | Nil> = element getAttribute: 'initializer'.
	v = mapping at: name ifAbsentPut: [
	    expr = nil ifFalse: [targetDocument evaluateFragment: expr]
	               ifTrue: [(StaticLabelFragment text: 'Missing initializer attribute') color: (Color r: 1 g: 0 b: 0)]].
      |
      element appendChild: v visual
    ].
)
public processClassPresenters = (
	domElementsWithClass: 'classPresenter' do: [:element |
		|
		errorBlock =
			[:errorMessage <String> |
			^EmbeddedHopscotchWindow
				into: element
				openSubject: (ErrorSubject onModel: errorMessage)].
		className <String> = element getAttribute: 'className'.
		klass <Class>
		cm <ClassDeclarationMirror>
		|
		klass:: namespace at: className ifAbsent: [nil].
		klass isKindOfBehavior ifFalse: [errorBlock value: className, ' is not a class'].
		(* isKindOfClass should be defined but isn't. *)
		cm:: (ClassMirror reflecting: klass) mixin declaration.
		EmbeddedIDEWindow
			into: element
			openSubject: (ClassSubject onDeclaration: cm)
	].
)
public processMinibrowsers = (
	domElementsWithClass: 'minibrowser' do:
		[:element |
		EmbeddedIDEWindow
			into: element
			openSubject: HomeSubject new].
)
public start = (
    processAmplets.
	processEvaluators.
	processMinibrowsers.
	processClassPresenters.
)
) : (
)