diff --git a/.gitignore b/.gitignore index 6cfba39b..6554c508 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,21 @@ -**/xcuserdata -.vscode -workspace.code-workspace -out -buildlocal.sh +.DS_Store +node_modules +dist +dev-dist +build +types +.idea +.github +package-lock.json + +# The directory 'pwa-deployed-versions' keeps track of PWA cache versions +# for URLs deployed from this repository. +# Only the 'newspeaklanguage.org.version' (the PWA version for newspeaklanguage.org) +# is kept in git. +# Any other version files, for example 'localhost.version', should not be committed. +!pwa-deployed-versions +pwa-deployed-versions/* +!pwa-deployed-versions/newspeaklanguage.org.version + +# The directory 'out' is ignored +/out/ diff --git a/ADocument.html b/ADocument.html new file mode 100644 index 00000000..a86331aa --- /dev/null +++ b/ADocument.html @@ -0,0 +1,147 @@ +
+
+

A Sample Document

This is a
+ embedded in a document! + And here is another one: and another +
+

Maintaining State

+ Here is a toggle that maintains its state while we edit: +
+ Let us add another widget +

Dealing with Errors

+What if the expression given in the document does not evaluate to a + Fragment? +
+ If it evaluates without error, we place an + error message that links to an inspector on the result in the + document. +
+
+
+Consider a bad selector in the name attribute of an ampleforth node. +
+
+
+If the expression does not compile at all, what do we do? +
No longer an +issue in the new design. +
+Likewise if the initializer attribute is missing. +
+Another interesting situation is recursion, as attempted below, which yields an informative error message: +
+
+
+
+
+
+ + + + + + + + \ No newline at end of file diff --git a/AccessModifierTesting.ns b/AccessModifierTesting.ns index acb67130..00b9630d 100644 --- a/AccessModifierTesting.ns +++ b/AccessModifierTesting.ns @@ -1,6 +1,7 @@ Newspeak3 -'AccessModifierTests' -class AccessModifierTesting usingPlatform: platform testFramework: minitest = (| +'Root' +class AccessModifierTesting usingPlatform: platform testFramework: minitest +(* :exemplar: AccessModifierTesting usingPlatform: platform testFramework: ide minitest *) = (| private TestContext = minitest TestContext. private ClassMirror = platform mirrors ClassMirror. private MessageNotUnderstood = platform kernel MessageNotUnderstood. diff --git a/AccessModifierTestingConfiguration.ns b/AccessModifierTestingConfiguration.ns index d26fc531..e5a1d7ee 100644 --- a/AccessModifierTestingConfiguration.ns +++ b/AccessModifierTestingConfiguration.ns @@ -1,5 +1,5 @@ Newspeak3 -'AccessModifierTests' +'Root' class AccessModifierTestingConfiguration packageTestsUsing: manifest = (| private AccessModifierTesting = manifest AccessModifierTesting. |) ( diff --git a/ActivationMirrorTesting.ns b/ActivationMirrorTesting.ns index 10ffb8c0..392c4dac 100644 --- a/ActivationMirrorTesting.ns +++ b/ActivationMirrorTesting.ns @@ -1,6 +1,6 @@ Newspeak3 -'Mirrors' -class ActivationMirrorTesting usingPlatform: p minitest: m = (| +'Root' +class ActivationMirrorTesting usingPlatform: p testFramework: m = (| private ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder. private ObjectMirror = p mirrors ObjectMirror. private ActivationMirror = p mirrors ActivationMirror. diff --git a/ActivationMirrorTestingConfiguration.ns b/ActivationMirrorTestingConfiguration.ns index 3c4a7940..9504c27d 100644 --- a/ActivationMirrorTestingConfiguration.ns +++ b/ActivationMirrorTestingConfiguration.ns @@ -1,10 +1,10 @@ Newspeak3 -'Mirrors' +'Root' class ActivationMirrorTestingConfiguration packageTestsUsing: manifest = (| private ActivationMirrorTesting = manifest ActivationMirrorTesting. |) ( public testModulesUsingPlatform: p minitest: m = ( - ^{ActivationMirrorTesting usingPlatform: p minitest: m} + ^{ActivationMirrorTesting usingPlatform: p testFramework: m} ) ) : ( ) diff --git a/ActorsForV8.ns b/ActorsForJS.ns similarity index 97% rename from ActorsForV8.ns rename to ActorsForJS.ns index d8aea2b6..61e91ebc 100644 --- a/ActorsForV8.ns +++ b/ActorsForJS.ns @@ -1,6 +1,6 @@ Newspeak3 -'Actors' -class ActorsForV8 usingPlatform: p = (| +'Root' +class ActorsForJS usingPlatform: p = (| private WeakMap = p collections IdentityMap. private List = p collections List. private Message = p kernel Message. @@ -10,7 +10,7 @@ private internalRefs = WeakMap new public Promise = PromiseUtils new. defaultActor = DOMActor named: 'Default actor'. -|js assign: (js ident: 'currentActor') toBe: defaultActor) ( +|_js assign: (_js ident: 'currentActor') toBe: defaultActor) ( public class Actor named: debugName = (| private (* N.B. Do not leak to subinstances. *) internalActor = DOMActor named: debugName. |) ( @@ -40,9 +40,9 @@ public enqueueMessage: actorMessage = ( (* bogus - should drain an explicit queue to allow for a randomizing scheduler *) js - call: (js propertyOf: (js ident: 'theGlobalObject') at: (js literal: 'setTimeout')) - with: {[js assign: (js ident: 'currentActor') toBe: self. - actorMessage deliverIn: self]. js literal: 0}. + call: (_js propertyOf: (_js ident: 'theGlobalObject') at: (_js literal: 'setTimeout')) + with: {[_js assign: (_js ident: 'currentActor') toBe: self. + actorMessage deliverIn: self]. _js literal: 0}. ) ) : ( ) @@ -664,11 +664,11 @@ public isTimer ^ = ( ^true ) protected schedule: callback after: ms = ( - js call: (js propertyOf: (js ident: 'window') at: (js literal: 'setTimeout')) + _js call: (_js propertyOf: (_js ident: 'window') at: (_js literal: 'setTimeout')) with: {callback. ms} ) protected schedule: callback every: ms = ( - js call: (js propertyOf: (js ident: 'window') at: (js literal: 'setInterval')) + _js call: (_js propertyOf: (_js ident: 'window') at: (_js literal: 'setInterval')) with: {callback. ms} ) ) : ( @@ -749,10 +749,10 @@ private createRemotePromiseOf: resolverInTarget in: targetActor for: sourceActor ^Ref wrapping: sourceResolver __owner: sourceActor. ) private currentActor = ( - ^js ident: 'currentActor' + ^_js ident: 'currentActor' ) private isRef: object ^ = ( - ^Ref == (js propertyOf: object at: (js literal: 'newspeakClass')) + ^Ref == (_js propertyOf: object at: (_js literal: 'newspeakClass')) ) private isValueObject: object ^ = ( nil == object ifTrue: [^true]. @@ -775,5 +775,10 @@ private wrapArgument: argument from: sourceActor to: targetActor = ( private wrapArguments: arguments from: sourceActor to: targetActor = ( ^arguments collect: [:argument | wrapArgument: argument from: sourceActor to: targetActor]. ) +public ultimateExceptionHandler: h <[:Exception :Activation]> = ( + (*:TODO :Bogus Used by the debugger + handlerOfLastResort:: h + *) +) ) : ( ) diff --git a/AliensForJS.ns b/AliensForJS.ns new file mode 100644 index 00000000..8bdf0577 --- /dev/null +++ b/AliensForJS.ns @@ -0,0 +1,156 @@ +Newspeak3 +'Root' +class AliensForJS usingPlatform: p = ( +(* Aliens are a capability-based API for a foreign function interface (FFI). On NS2JS, they allow Newspeak code to invoke JavaScript code and vice versa. + +An Alien is a Newspeak proxy for a JavaScript object. Upon receiving a message, an Alien expatriates the arguments, sends the message to the target JavaScript object, and alienates the result. + +An Expat is a JavaScript proxy for a Newspeak object. Upon receiving a message, an Expat alienates the arguments, sends the message to the target Newspeak object, and expatriates the result. + +A bilingual object is one whose representation is the same in both languages: unwrapped basic types such as numbers, booleans. Note that even though Newspeak and JavaScript closures have the same representation, they are not bilingual and wrapping should occur because Newspeak closures expect Newspeak/Alien arguments and JavaScript closures expect JavaScript/Expat arguments. What about strings and arrays? It would seem we have to wrap arrays because their elements should be alieniated/expatriated. It may be safe to treat strings as bilingual if they always respond to messages with other bilingual objects. + +Alien mappings: +alien sort: a ignored: b ignored: c -> alien.sort(a, b, c) +alien new: a ignored: b ignored: c -> new alien(a, b, c) +alien at: 'a' -> alien.a +alien at: 'a' put: b -> alien.a = b + +Expat mappings: +? + +*) +| +public global = Alien wrapping: (_js ident: 'theGlobalObject'). +public undefined = Alien wrapping: (_js ident: 'undefined'). +|) ( +class Alien wrapping: o = ( + _js assign: (_js propertyOf: self at: (_js literal: 'jsTarget')) toBe: o. +) ( +public at: key = ( + ^alienate: (_js + call: (_js propertyOf: (_js ident: 'Reflect') at: (_js literal: 'get')) + with: {_js propertyOf: self at: (_js literal: 'jsTarget'). expatriate: key}) +) +public at: key put: value = ( + _js + call: (_js propertyOf: (_js ident: 'Reflect') at: (_js literal: 'set')) + with: {_js propertyOf: self at: (_js literal: 'jsTarget'). expatriate: key. expatriate: value}. + ^value +) +doesNotUnderstand: msg = ( + | jsTarget jsArguments jsSelector jsResult | + jsTarget:: _js propertyOf: self at: (_js literal: 'jsTarget'). + jsArguments:: msg arguments collect: [:arg | expatriate: arg]. + jsSelector:: copyUntilFirstColon: msg mangledSelector. + jsResult:: jsSelector = 'new' + ifTrue: + [_js call: (_js propertyOf: (_js ident: 'Reflect') at: (_js literal: 'construct')) with: {jsTarget. jsArguments}] + ifFalse: + [ | jsFunction | + jsFunction:: _js propertyOf: jsTarget at: jsSelector. + (_js operator: '===' with: jsFunction and: (_js ident: 'undefined')) + ifTrue: [^super doesNotUnderstand: msg]. + _js call: (_js propertyOf: (_js ident: 'Reflect') at: (_js literal: 'apply')) with: {jsFunction. jsTarget. jsArguments}]. + ^alienate: jsResult +) +public isUndefined = ( + ^_js operator: '===' with: (_js propertyOf: self at: (_js literal: 'jsTarget')) and: (_js ident: 'undefined') +) +public printString = ( + self isUndefined ifTrue: [^'undefined']. (* undefined.toString() throws in JS *) + ^(_js call: (_js propertyOf: (_js propertyOf: self at: (_js literal: 'jsTarget')) at: (_js literal: 'toString')) with: {}) +) +public value = ( + | jsTarget = _js propertyOf: self at: (_js literal: 'jsTarget'). | + ^alienate: (_js + call: (_js propertyOf: jsTarget at: (_js literal: 'call')) + with: {jsTarget}) +) +public value: a1 = ( + | jsTarget = _js propertyOf: self at: (_js literal: 'jsTarget'). | + ^alienate: (_js + call: (_js propertyOf: jsTarget at: (_js literal: 'call')) + with: {jsTarget. expatriate: a1}) +) +public value: a1 value: a2 = ( + | jsTarget = _js propertyOf: self at: (_js literal: 'jsTarget'). | + ^alienate: (_js + call: (_js propertyOf: jsTarget at: (_js literal: 'call')) + with: {jsTarget. expatriate: a1. expatriate: a2}) +) +public value: a1 value: a2 value: a3 = ( + | jsTarget = _js propertyOf: self at: (_js literal: 'jsTarget'). | + ^alienate: (_js + call: (_js propertyOf: jsTarget at: (_js literal: 'call')) + with: {jsTarget. expatriate: a1. expatriate: a2. expatriate: a3}) +) +public valueWithArguments: args = ( + | jsTarget = _js propertyOf: self at: (_js literal: 'jsTarget'). | + ^alienate: (_js + call: (_js propertyOf: jsTarget at: (_js literal: 'apply')) + with: {jsTarget. args collect: [:nsArg | expatriate: nsArg]}) +) +public isKindOfJSAlien ^ = ( + ^true +) +) : ( +) +class Expat wrapping: o = ( + (* :todo: Implement with ES6 Proxy instead. *) + _js assign: (_js propertyOf: self at: (_js literal: 'nsTarget')) toBe: o. +) ( +public isKindOfJSAlien ^ = ( + ^false +) +) : ( +) +expatriateBlock: b = ( + ^_js functionOf: {} body: ( + _js return: ( + expatriate: ( + b valueWithArguments: ( + (_js verbatim: 'Array.prototype.slice.call(arguments, 0)') collect: [:ea | alienate: ea])))) +) +alienate: jsObj = ( + #TODO. + (_js operator: '===' with: (_js ident: 'null') and: jsObj) ifTrue: [^nil]. + (_js prefixOperator: 'typeof ' on: jsObj) == 'string' ifTrue: [^jsObj]. + (_js prefixOperator: 'typeof ' on: jsObj) == 'number' ifTrue: [^jsObj]. + (_js prefixOperator: 'typeof ' on: jsObj) == 'boolean' ifTrue: [^jsObj]. + (* This does not discrimate NS vs JS closures *) + (_js prefixOperator: 'typeof ' on: jsObj) == 'function' ifTrue: [^Alien wrapping: jsObj]. + (_js operator: 'instanceof' with: jsObj and: (_js propertyOf: (_js propertyOf: Object at: (_js literal: 'runtimeClass')) at: (_js literal: 'basicNew'))) + ifTrue: + [jsObj isKindOfJSAlien ifTrue: [Error signal: 'Shouldnt be asked to double alienate...']. + jsObj isKindOfExpat ifTrue: [^_js propertyOf: jsObj at: (_js literal: 'nsTarget')]. + Error signal: 'Asked to alienate a raw Newspeak object...']. + (_js operator: 'instanceof' with: jsObj and: (_js ident: 'Uint8Array')) ifTrue: [^jsObj]. + ^Alien wrapping: jsObj +) +expatriate: nsObj = ( + #TODO. + (_js operator: '===' with: nil and: nsObj) ifTrue: [^_js ident: 'null']. + (_js prefixOperator: 'typeof ' on: nsObj) == 'string' ifTrue: [^nsObj]. + (_js prefixOperator: 'typeof ' on: nsObj) == 'number' ifTrue: [^nsObj]. + (_js prefixOperator: 'typeof ' on: nsObj) == 'boolean' ifTrue: [^nsObj]. + (* This does not discrimate NS vs JS closures *) + (_js prefixOperator: 'typeof ' on: nsObj) == 'function' ifTrue: [^expatriateBlock: nsObj]. + (_js operator: 'instanceof' with: nsObj and: (_js propertyOf: (_js propertyOf: Object at: (_js literal: 'runtimeClass')) at: (_js literal: 'basicNew'))) + ifTrue: + [nsObj isKindOfJSAlien ifTrue: [^_js propertyOf: nsObj at: (_js literal: 'jsTarget')]. + nsObj isKindOfExpat ifTrue: [Error signal: 'Shouldnt be asked to double expatriate...']. + ^Expat wrapping: nsObj.]. + (_js operator: 'instanceof' with: nsObj and: (_js ident: 'Uint8Array')) ifTrue: [^nsObj]. + Error signal: 'Asked to expatriate a raw JS object...' +) +public localStorage ^ = ( + ^(global at: #window) at: #localStorage +) +copyUntilFirstColon: sel = ( + #BOGUS. (* DNU does not yet pass unmangled selectors. *) + 2 to: sel size do: [:i | + ((sel at: i) = ("$" at: 1)) ifTrue: [^sel copyFrom: 2 to: i - 1]]. + ^sel copyFrom: 2 to: sel size +) +) : ( +) diff --git a/AliensForV8.ns b/AliensForV8.ns deleted file mode 100644 index 2c832d7c..00000000 --- a/AliensForV8.ns +++ /dev/null @@ -1,158 +0,0 @@ -Newspeak3 -'Aliens' -class AliensForV8 usingPlatform: p = ( -(* Aliens are a capability-based API for a foreign function interface (FFI). On NS2V8, they allow Newspeak code to invoke JavaScript code and vice versa. - -An Alien is a Newspeak proxy for a JavaScript object. Upon receiving a message, an Alien expatriates the arguments, sends the message to the target JavaScript object, and alienates the result. - -An Expat is a JavaScript proxy for a Newspeak object. Unpon receiving a message, an Expat alienates the arguments, sends the message to the target Newspeak object, and expatriates the result. - -A bilingual object is one whose representation is the same in both languages: unwrapped basic types such as numbers, booleans. Note that even though Newspeak and JavaScript closures have the same representation, they are not bilingual and wrapping should occur because Newspeak closures expect Newspeak/Alien arguments and JavaScript closures expect JavaScript/Expat arguments. What about strings and arrays? It would seem we have to wrap arrays because their elements should be alieniated/expatriated. It may be safe to treat strings as bilingual if they always respond to messages with other bilingual objects. - -Alien mappings: -alien sort: a ignored: b ignored: c -> alien.sort(a, b, c) -alien new: a ignored: b ignored: c -> new alien(a, b, c) -alien at: 'a' -> alien.a -alien at: 'a' put: b -> alien.a = b - -Expat mappings: -? - -*) -| -public global = Alien wrapping: (js ident: 'theGlobalObject'). -|) ( -class Alien wrapping: o = ( - js assign: (js propertyOf: self at: (js literal: 'jsTarget')) toBe: o. -) ( -public at: key = ( - ^alienate: (js - call: (js propertyOf: (js ident: 'Reflect') at: (js literal: 'get')) - with: {js propertyOf: self at: (js literal: 'jsTarget'). expatriate: key}) -) -public at: key put: value = ( - js - call: (js propertyOf: (js ident: 'Reflect') at: (js literal: 'set')) - with: {js propertyOf: self at: (js literal: 'jsTarget'). expatriate: key. expatriate: value}. - ^value -) -doesNotUnderstand: msg = ( - | jsTarget jsArguments jsSelector jsResult | - jsTarget:: js propertyOf: self at: (js literal: 'jsTarget'). - jsArguments:: msg arguments collect: [:arg | expatriate: arg]. - jsSelector:: copyUntilFirstColon: msg mangledSelector. - jsResult:: jsSelector = 'new' - ifTrue: - [js call: (js propertyOf: (js ident: 'Reflect') at: (js literal: 'construct')) with: {jsTarget. jsArguments}] - ifFalse: - [ | jsFunction | - jsFunction:: js propertyOf: jsTarget at: jsSelector. - (js operator: '===' with: jsFunction and: (js ident: 'undefined')) - ifTrue: [^super doesNotUnderstand: msg]. - js call: (js propertyOf: (js ident: 'Reflect') at: (js literal: 'apply')) with: {jsFunction. jsTarget. jsArguments}]. - ^alienate: jsResult -) -public isAlien ^ = ( - ^true -) -public isExpat ^ = ( - ^false -) -public isUndefined = ( - ^js operator: '===' with: (js propertyOf: self at: (js literal: 'jsTarget')) and: (js ident: 'undefined') -) -public printString = ( - self isUndefined ifTrue: [^'undefined']. (* undefined.toString() throws in JS *) - ^(js call: (js propertyOf: (js propertyOf: self at: (js literal: 'jsTarget')) at: (js literal: 'toString')) with: {}) -) -public value = ( - | jsTarget = js propertyOf: self at: (js literal: 'jsTarget'). | - ^alienate: (js - call: (js propertyOf: jsTarget at: (js literal: 'call')) - with: {jsTarget}) -) -public value: a1 = ( - | jsTarget = js propertyOf: self at: (js literal: 'jsTarget'). | - ^alienate: (js - call: (js propertyOf: jsTarget at: (js literal: 'call')) - with: {jsTarget. expatriate: a1}) -) -public value: a1 value: a2 = ( - | jsTarget = js propertyOf: self at: (js literal: 'jsTarget'). | - ^alienate: (js - call: (js propertyOf: jsTarget at: (js literal: 'call')) - with: {jsTarget. expatriate: a1. expatriate: a2}) -) -public value: a1 value: a2 value: a3 = ( - | jsTarget = js propertyOf: self at: (js literal: 'jsTarget'). | - ^alienate: (js - call: (js propertyOf: jsTarget at: (js literal: 'call')) - with: {jsTarget. expatriate: a1. expatriate: a2. expatriate: a3}) -) -public valueWithArguments: args = ( - | jsTarget = js propertyOf: self at: (js literal: 'jsTarget'). | - ^alienate: (js - call: (js propertyOf: jsTarget at: (js literal: 'apply')) - with: {jsTarget. args collect: [:nsArg | expatriate: nsArg]}) -) -) : ( -) -class Expat wrapping: o = ( - (* :todo: Implement with ES6 Proxy instead. *) - js assign: (js propertyOf: self at: (js literal: 'nsTarget')) toBe: o. -) ( -public isAlien ^ = ( - ^false -) -public isExpat ^ = ( - ^true -) -) : ( -) -alienate: jsObj = ( - #TODO. - (js operator: '===' with: (js ident: 'null') and: jsObj) ifTrue: [^nil]. - (js prefixOperator: 'typeof ' on: jsObj) == 'string' ifTrue: [^jsObj]. - (js prefixOperator: 'typeof ' on: jsObj) == 'number' ifTrue: [^jsObj]. - (js prefixOperator: 'typeof ' on: jsObj) == 'boolean' ifTrue: [^jsObj]. - (* This does not discrimate NS vs JS closures *) - (js prefixOperator: 'typeof ' on: jsObj) == 'function' ifTrue: [^Alien wrapping: jsObj]. - (js operator: 'instanceof' with: jsObj and: (js propertyOf: (js propertyOf: Object at: (js literal: 'runtimeClass')) at: (js literal: 'basicNew'))) - ifTrue: - [jsObj isAlien ifTrue: [Error signal: 'Shouldnt be asked to double alienate...']. - jsObj isExpat ifTrue: [^js propertyOf: jsObj at: (js literal: 'nsTarget')]. - Error signal: 'Asked to alienate a raw Newspeak object...']. - (js operator: 'instanceof' with: jsObj and: (js ident: 'Uint8Array')) ifTrue: [^jsObj]. - ^Alien wrapping: jsObj -) -copyUntilFirstColon: sel = ( - #BOGUS. (* DNU does not yet pass unmangled selectors. *) - 2 to: sel size do: [:i | - ((sel at: i) = "$") ifTrue: [^sel copyFrom: 2 to: i - 1]]. - ^sel copyFrom: 2 to: sel size -) -expatriate: nsObj = ( - #TODO. - (js operator: '===' with: nil and: nsObj) ifTrue: [^js ident: 'null']. - (js prefixOperator: 'typeof ' on: nsObj) == 'string' ifTrue: [^nsObj]. - (js prefixOperator: 'typeof ' on: nsObj) == 'number' ifTrue: [^nsObj]. - (js prefixOperator: 'typeof ' on: nsObj) == 'boolean' ifTrue: [^nsObj]. - (* This does not discrimate NS vs JS closures *) - (js prefixOperator: 'typeof ' on: nsObj) == 'function' ifTrue: [^expatriateBlock: nsObj]. - (js operator: 'instanceof' with: nsObj and: (js propertyOf: (js propertyOf: Object at: (js literal: 'runtimeClass')) at: (js literal: 'basicNew'))) - ifTrue: - [nsObj isAlien ifTrue: [^js propertyOf: nsObj at: (js literal: 'jsTarget')]. - nsObj isExpat ifTrue: [Error signal: 'Shouldnt be asked to double expatriate...']. - ^Expat wrapping: nsObj.]. - (js operator: 'instanceof' with: nsObj and: (js ident: 'Uint8Array')) ifTrue: [^nsObj]. - Error signal: 'Asked to expatriate a raw JS object...' -) -expatriateBlock: b = ( - ^js functionOf: {} body: ( - js return: ( - expatriate: ( - b valueWithArguments: ( - (js verbatim: 'Array.prototype.slice.call(arguments, 0)') collect: [:ea | alienate: ea])))) -) -) : ( -) diff --git a/Ampleforth.ns b/Ampleforth.ns index 26e9b42f..496211be 100644 --- a/Ampleforth.ns +++ b/Ampleforth.ns @@ -1,27 +1,31 @@ Newspeak3 -'Samples' +'Root' class Ampleforth packageUsing: manifest = ( -(* Ampleforth is designed to support live literate programming. It supports embedding Newspeak code inside the text of a normal web page. Ampleforth is in its infancy, and currently can be used in conjunction with other tools such as Madoko, Lounge or plain old HTML to produce such documents. +(* Ampleforth is designed to support live literate programming. It supports embedding Newspeak code inside the text of a normal web page. This class relates to an older version of Ampleforth. It has different properties than the latest one. It relies on AmpleforthEmbedder to process a web page once and for all, inserting Hopscotch widgets from a limited set into the page at startup. +It does not support live editing of the HTML, and any extension of the set of widgets would require changing AmpleforthEmbedder. +The pages so created are not self contained. They are effectively read-only, which can be an advantage in some cases. It also relies on a arguably simpler conventions in the HTML. -Ampleforth is the name of a character in 1984 who worked at the Ministry of Truth. His job was to edit Oldspeak text so it would be goodthinkful. +Ampleforth documents can be produced by editing HTML in any tool. Use this application to run such pages stand alone. One can also interactively edit and run such documents in the Newspeak IDE (see the HopscotchWebIDE module). -Copyright 2014-2017 Google Inc. *) +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 hopscotchRuntime = manifest HopscotchForHTML5Runtime packageUsing: manifest. - private Embedder = manifest AmpleforthEmbedder. + private AmpleforthEmbedder = manifest AmpleforthEmbedder. private HopscotchIDE = manifest HopscotchWebIDE packageUsing: manifest. | ) ( public main: platform args: args = ( | - hopscotchPlatform = hopscotchRuntime using: platform. namespace embedder ide | - ide:: HopscotchIDE ideUsingPlatform: hopscotchPlatform. + ide:: HopscotchIDE ideUsingPlatform: platform. namespace:: ide namespacing Root. namespace at: #Ampleforth put: self class. - embedder:: Embedder usingPlatform: hopscotchPlatform namespace: namespace browsing: ide browsing. + embedder:: AmpleforthEmbedder usingPlatform: platform ide: ide. embedder start. ) ) : ( diff --git a/AmpleforthEmbedder.ns b/AmpleforthEmbedder.ns index 1fd86d1a..67cde0a8 100644 --- a/AmpleforthEmbedder.ns +++ b/AmpleforthEmbedder.ns @@ -1,32 +1,42 @@ Newspeak3 'Root' -class AmpleforthEmbedder usingPlatform: p namespace: ns browsing: b = ( +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. Ampleforth is in its infancy, and currently can be used in conjunction with Madoko to produce such documents. +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 is the name of a character in 1984 who worked at the Ministry of Truth. His job was to edit Oldspeak text so it would be goodthinkful. +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. *) | - List = p collections List. - Color = p graphics Color. - ObjectMirror = p mirrors ObjectMirror. - ClassMirror = p mirrors ClassMirror. - Subject = p hopscotch core Subject. - Presenter = p hopscotch core Presenter. - TextEditorFragment = p hopscotch fragments TextEditorFragment. - Gradient = p hopscotch Gradient. - EmbeddedHopscotchWindow = p hopscotch core EmbeddedHopscotchWindow. - EvaluationViewState = b EvaluationViewState. - EvaluatorSubject = b EvaluatorSubject. - ObjectSubject = b ObjectSubject. - - namespace = ns. - browsing = b. + 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) ( + | + namespace at: #AmpleforthEmbedder put: self class + ) ( class ErrorPresenter onSubject: s = Presenter onSubject: s ( ) ( public definition ^ = ( @@ -47,6 +57,12 @@ class ErrorSubject onModel: s = Subject onModel: s ( public createPresenter ^ = ( ^ErrorPresenter onSubject: self ) +isMyKind: other ^ = ( + ^other isKindOfErrorSubject +) +public isKindOfErrorSubject ^ = ( + ^true +) ) : ( ) domElementsWithClass: klass do: action <[:Alien[Element]]> = ( @@ -67,32 +83,6 @@ evaluateSubject: se ^ = ( ifError: [:e | ^ErrorSubject onModel: 'runtime error: ', e printString]. ^blk value: browsing ) -public processClassPresenters = ( - domElementsWithClass: 'classPresenter' do: [:element | - | - errorBlock = - [:errorMessage | - ^EmbeddedHopscotchWindow - into: element - openSubject: (ErrorSubject onModel: errorMessage)]. - className = element getAttribute: 'className'. - klass - cm - | - 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. - EmbeddedHopscotchWindow - into: element - openSubject: (browsing ClassSubject onModel: cm) - ]. -) -public start = ( - processEvaluators. - processMinibrowsers. - processClassPresenters. -) topLevelClassOf: om ^ = ( | klass ::= om getClass mixin declaration. | [klass mixin enclosingClass isNil] whileFalse: [klass:: klass enclosingClass]. @@ -109,12 +99,15 @@ withoutNbsp: string = ( space = String fromRune: 32. | ^string replaceAll: nonbreakingSpace with: space] ) -public processMinibrowsers = ( - domElementsWithClass: 'minibrowser' do: - [:element | - EmbeddedHopscotchWindow - into: element - openSubject: browsing HomeSubject new]. +populateNamespace = ( + | platformClass = topLevelClassOf: platformMirror. | + namespace at: #Browsing put: (ClassMirror reflecting: self Browsing) mixin declaration. + namespace at: platformClass name put: platformClass. + platformClass slots do: [:s | | klass o | + o:: platformMirror getSlot: s name. + klass:: topLevelClassOf: o. + namespace at: klass name put: klass. + ]. ) public processEvaluators = ( domElementsWithClass: 'evaluator' do: @@ -126,19 +119,56 @@ public processEvaluators = ( | es initialSource: expression. es evaluateLive: expression. - EmbeddedHopscotchWindow + EmbeddedIDEWindow into: element openSubject: es]. ) -populateNamespace = ( - | platformClass = topLevelClassOf: platformMirror. | - namespace at: #Browsing put: (ClassMirror reflecting: self Browsing) mixin declaration. - namespace at: platformClass name put: platformClass. - platformClass slots do: [:s | | klass o | - o:: platformMirror getSlot: s name. - klass:: topLevelClassOf: o. - namespace at: klass name put: klass. - ]. +public processAmplets = ( + | targetDocument = Document named: 'dummy' contents: ''. | + domElementsWithClass: 'ampleforth' do: [:element | + | + name = element getAttribute: 'name'. + expr = 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 | + ^EmbeddedHopscotchWindow + into: element + openSubject: (ErrorSubject onModel: errorMessage)]. + className = element getAttribute: 'className'. + klass + cm + | + 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. ) ) : ( ) diff --git a/AmpleforthViewer.ns b/AmpleforthViewer.ns new file mode 100644 index 00000000..84a196fb --- /dev/null +++ b/AmpleforthViewer.ns @@ -0,0 +1,71 @@ +Newspeak3 +'Root' +class AmpleforthViewer packageUsing: manifest = ( +(* +An app that opens a pre-determined Ampleforth document. + +Given a URI of the form primordialsoup.html/?snapshot=AmpleforthEditorApp&docName=myDoc, it can open to the desired document. + +If the document is not avaliable on the server, an error document is opened with an explanation of the problem. + +Ideally, we would isolate the web dependencies we have here so that the code would work on alternate platforms. +Among other things, we would need the web implementation to pass in the URI arguments to #main:args: so we would not be concerned with that here. We'd want a mature, portable Newspeak file API as well. For the foreseeable future, this will do. +*) + | + private HopscotchIDE = manifest HopscotchWebIDE packageUsing: manifest. + | +) ( +missingDocument: docName in: ide ^ = ( + | + errorMessage = docName isEmpty + ifFalse: [ '

No document named ', docName, ' found on server

'] + ifTrue: [ '

No document specified. You must specify a document name in the URI using the docName parameter. Use the format +

+ primordialsoup.html/?snapshot=AmpleforthEditorApp&docName=myDoc +

+ where myDoc is the name of the desired document. +
+ Make sure you didn''t write ?docName=myDoc, or mispell or omit docName. + ']. + | + ^ide documents freshDocumentNamed: #MissingDocumentNotice initialText: errorMessage +) +public main: platform args: args = ( + | + ide = HopscotchIDE ideUsingPlatform: platform. + documents = ide documents. + (* Get the current URI and return the value of parameter 'docName', this being the name of the document we should open *) + rawName = (((platform js global at: #URL) new: ((platform js global at: #window) at: #location)) at: #searchParams) get: #docName. + (* If docName argument is missing, rawName will be nil, which would cause difficulties. Guard against this. *) + docName = rawName isNil ifFalse: [rawName] ifTrue: ['']. + request = (platform js global at: #XMLHttpRequest) new. + JSZip = platform js global at: 'JSZip'. + | + ide setupNames. + ide launch: (ide browsing HomeSubject new). + request + open: 'GET' filenamed: docName, '.zip' flag: true; + at: #responseType put: 'blob'; + at: #onload put: [:event | + | + jszp = JSZip loadAsync: (request at: #response). + | + jszp then: [:jsz | + | namespace = ide browsing NamespaceSubject onModel: ide namespacing Root key: #Root. | + documents loadDocument: jsz named: docName into: namespace + ifSuccess: [ide browsing Utilities enterSubject: (documents DocumentSubject onModel: (namespace model at: docName))] + ifFailure: [ + | failureDoc = missingDocument: docName in: ide. | + ide browsing Utilities enterSubject: (documents DocumentSubject onModel: failureDoc). + ]. + nil + ] onError: [:ex | + | failureDoc = missingDocument: docName in: ide. | + ide browsing Utilities enterSubject: (documents DocumentSubject onModel: failureDoc). + nil + ] + ]; + send. +) +) : ( +) diff --git a/BankAccount.ns b/BankAccount.ns new file mode 100644 index 00000000..da6fba22 --- /dev/null +++ b/BankAccount.ns @@ -0,0 +1,24 @@ +Newspeak3 +'Root' +class BankAccount balance: b +(* :exemplar: BankAccount balance: 100 *) = ( +(* Copyright 2021-2022 Gilad Bracha *) + | + balance_slot ::= b. + | +) ( +public balance = ( + ^balance_slot +) +public deposit: amount (* :exemplar: deposit: 100 *) = ( + balance_slot:: balance + amount +) +public withdraw: amount +(* :exemplar1: withdraw: 10 *) (* :exemplar2: withdraw: 0 *) (* :exemplar3: withdraw: 110 *)(* :exemplar4: withdraw: 20 negated *) = ( + amount > balance ifTrue: [ + Error signal: 'Overdraft not allowed. Withdrawal amount ', amount printString, ' exceeds balance ', balance printString + ]. + balance_slot:: balance - amount +) +) : ( +) diff --git a/BankAccountExemplarDemo.ns b/BankAccountExemplarDemo.ns new file mode 100644 index 00000000..1f4526b9 --- /dev/null +++ b/BankAccountExemplarDemo.ns @@ -0,0 +1,29 @@ +Newspeak3 +'Root' +class BankAccountExemplarDemo packageUsing: manifest = ( +(* +Demo of exemplars using BankAccount class. + +Copyright 2014-2017 Google Inc. +Copyright 2021-2022 Gilad Bracha +*) +| + private AmpleforthEmbedder = manifest AmpleforthEmbedder. + private HopscotchIDE = manifest HopscotchWebIDE packageUsing: manifest. + private BankAccount = manifest BankAccount. +|) ( +populateNamespace: namespace = ( + namespace at: #BankAccountExemplarDemo put: self class. + namespace at: #BankAccount put: BankAccount. +) +public main: platform args: args = ( + | + ide = HopscotchIDE ideUsingPlatform: platform. + namespace = ide namespacing Root. + embedder = AmpleforthEmbedder usingPlatform: platform namespace: namespace browsing: ide browsing. + | + populateNamespace: namespace. + embedder start. +) +) : ( +) diff --git a/Browsing.ns b/Browsing.ns index c3a1f776..9afa512d 100644 --- a/Browsing.ns +++ b/Browsing.ns @@ -1,36 +1,47 @@ Newspeak3 'Root' -class Browsing usingPlatform: p ide: webIde = ( +class Browsing usingPlatform: p ide: webIde +(* :exemplar: ide browsing *) += ( (* An IDE for Newspeak on the web. Copyright 2016-2017 Google Inc. - Copyright 2018-2020 Gilad Bracha. + Copyright 2018-2022 Gilad Bracha. *) | (* imports *) - StringBuilder = p kernel StringBuilder. - Subject = p hopscotch Subject. - Presenter = p hopscotch Presenter. - SearchFieldFragment = p hopscotch fragments SearchFieldFragment. - Window = p hopscotch Window. - Color = p graphics Color. - Gradient = p hopscotch Gradient. - List = p collections List. - Map = p collections Map. - Set = p collections Set. - OrderedMap = [p collections OrderedMap] on: Error do: [:e | Map]. - Exception = p kernel Exception. - ClassMirror = p mirrors ClassMirror. - ObjectMirror = p mirrors ObjectMirror. - Message = p kernel Message. - ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder. - Snapshotter = p operatingSystem = 'emscripten' ifTrue: [p victoryFuel Snapshotter]. - JSObject = p js global at: 'Object'. - JSArray = p js global at: 'Array'. - JSMath = p js global at: 'Math'. - JSPromise = p js global at: 'Promise'. - Date = p js global at: 'Date'. + private StringBuilder = p kernel StringBuilder. + private Subject = p hopscotch Subject. + private Presenter = p hopscotch Presenter. + private SearchFieldFragment = p hopscotch fragments SearchFieldFragment. + private Window = p hopscotch Window. + private DOMParser = p hopscotch DOMParser. + private Color = p graphics Color. + private Gradient = p hopscotch Gradient. + private List = p collections List. + private Map = p collections Map. + private Set = p collections Set. +(* private OrderedMap = [p collections OrderedMap] on: Error do: [:e | Map].*) + private Exception = p kernel Exception. + private Proxy = p kernel Proxy. + private ActivationMirror = p mirrors ActivationMirror. + private ClassMirror = p mirrors ClassMirror. + private ObjectMirror = p mirrors ObjectMirror. + private ClosureMirror = p mirrors ClosureMirror. + private Message = p kernel Message. + private ClassDeclarationBuilder = p mirrors ClassDeclarationBuilder. + private Snapshotter = p operatingSystem = 'emscripten' ifTrue: [p victoryFuel Snapshotter]. + private Deserializer = p operatingSystem = 'emscripten' ifTrue: [p victoryFuel Deserializer]. + private JSObject = p js global at: 'Object'. + private JSArray = p js global at: 'Array'. + private JSUint8Array = p js global at: #Uint8Array. + private JSMath = p js global at: 'Math'. + private JSPromise = p js global at: 'Promise'. + private JSZip = p js global at: 'JSZip'. + private Date = p js global at: 'Date'. + + (* module variables *) body = (p js global at: 'document') at: 'body'. - localStorage = (p js global at: 'window') at: 'localStorage'. + localStorage = p js localStorage. atomicInstaller = p mirrors installer. compiler = p mirrors compiler. cachedPlatform = p. @@ -38,21 +49,20 @@ class Browsing usingPlatform: p ide: webIde = ( detailAreaRatio = 3 asFloat. captionColor = Color h: 240 s: 0.05 asFloat v: 0.9 asFloat. cssConverter = cssConversionTable. - objectViews = Map new. + objectViews = Map new. + currentWindow + nonExemplarClasses = Set withAll: {#Number. #Class}. (* Style *) styleHeaderPadRight = 0.0. styleButtonSize = 30. - | p hopscotch homeSubjectClass: HomeSubject. initializeObjectViews. ) ( public class AssortedMethodsPresenter onSubject: s = DefinitionListPresenter onSubject: s ( -(* The subject is a collection of MethodSubjects that can come from diverse sources (in the sense that they do not have to belong to the same class). The presenter displays them as a column of expandable method presenters and takes care of reasonably handling the various creation and deletion requests coming from them. I group my methods by their containing package. - -Because the method presenters are grouped by package, if we need to expand or collapse those presenters, we only want to expand or collapse the method presenters. The group heading is not expandable (or collapsable). *) +(* The subject is a collection of MethodSubjects that can come from diverse sources (in the sense that they do not have to belong to the same class). The presenter displays them as a column of expandable method presenters and takes care of reasonably handling the various creation and deletion requests coming from them. *) | public title ::= 'Assorted Methods'. (* The title to use for the presenter *) methodPresenters ::= List new. @@ -64,10 +74,6 @@ public addNewItemTemplate = ( (* Handle a user's request to create a new method by displaying a new method template. *) shouldNotImplement ) -contentPresenters = ( - #BOGUS. - ^subject methodSubjects collect: [:each | (each presenter) showClassName: true] -) definitionListMenu = ( ^menuWithLabelsAndActions: { {'Inspect Presenter' . [respondToInspectPresenter]} @@ -79,11 +85,29 @@ public isKindOfAssortedMethodsPresenter ^ = ( isMyKind: f ^ = ( ^f isKindOfAssortedMethodsPresenter ) +contentPresenters ^ = ( + | + methods = subject elements sort: [ + :m1 :m2 | + lexicallyLessOrEqual: m1 name than: m2 name + ]. + | + ^methods collect: [:each | (each presenter) showClassName: true] +) +elementDescription ^ = ( + ^'methods grouped by some criteria' +) +listDescription ^ = ( + ^'assorted method list' +) ) : ( ) -public class AssortedMethodsSubject onModel: m = Subject onModel: m (| - public title ::= 'Assorted Methods'. -|) ( +public class AssortedMethodsSubject onModel: m = ProgrammingSubject onModel: m ( + | + public title ::= 'Assorted Methods'. + elements_slot + | +) ( public createPresenter = ( ^(AssortedMethodsPresenter onSubject: self) title: title ) @@ -93,23 +117,41 @@ public isKindOfAssortedMethodsSubject ^ = ( isMyKind: f ^ = ( ^f isKindOfAssortedMethodsSubject ) -public methodSubjects = ( - ^model -) public methodTemplateText ^ = ( ^ 'messageSelector = ( )' ) +public methodSubjects ^ = ( + ^model +) +public elements ^ = ( + (* Answer a collection of subjects on individual elements of the collection which is our subject. *) + elements_slot isNil ifTrue: [ + elements_slot:: methodSubjects. + ^elements_slot + ]. + updateElements. + ^elements_slot +) +updateElements = ( + | + obsoleteSubjects = List new. + | + elements_slot do: [:s | + (methodSubjects includes: s) ifFalse: [obsoleteSubjects add: s]. + ]. + obsoleteSubjects do: [:s | elements_slot remove: s]. + methodSubjects do: [:m | + (elements_slot includes: m) ifFalse: [ + elements_slot add: m + ]. + ]. +) ) : ( ) class BasicView onSubject: s = ProgrammingPresenter onSubject: s ( ) ( -public definition = ( - ^column: - (subject slots collect: - [:slot | slot presenter]) -) public isKindOfBasicView ^ = ( ^true ) @@ -119,6 +161,33 @@ isMyKind: other ^ = ( public title = ( ^'Basic' ) +slots = ( + | ss = subject slots. | + + ss isEmpty ifTrue: [^nothing]. + ^minorHeadingBlock: (column: { + (label: #Slots) bold. + taggedColumn: + (ss collect: + [:slot | slot presenter]) + } + ) +) +lazySlots = ( + | lss = subject lazySlots. | + + lss isEmpty ifTrue: [^nothing]. + ^minorHeadingBlock: (column: { + (label: 'Lazy Slots') bold. + taggedColumn: + (lss collect: + [:slot | slot presenter]) + } + ) +) +public definition = ( + ^column: {slots. lazySlots} +) ) : ( ) public class BitOfWisdom text: s actionLabel: l actionBlock: b <[]> image: i = (| @@ -152,46 +221,6 @@ public isKindOfClassActionsPresenter ^ = ( isMyKind: f ^ = ( ^f isKindOfClassActionsPresenter ) -deployAsWebPageWithMirrorBuilders = ( -#BOGUS yourself. - (ide deployment jsPackagerForPlatform: cachedPlatform) - packageApplicationConfiguration: (ide namespacing Root at: subject name) - withRuntimeConfiguration: ide deployment RuntimeWithMirrorBuilders - usingNamespace: ide namespacing Root. -) -deployAsWebPage = ( -#BOGUS yourself. - (ide deployment jsPackagerForPlatform: cachedPlatform) - packageApplicationConfiguration: (ide namespacing Root at: subject name) - withRuntimeConfiguration: ide deployment Runtime - usingNamespace: ide namespacing Root. -) -testActions = ( - subject isTestConfiguration ifFalse: [^nothing]. - ^row: { - link: '[run tests]' action: [enterSubject:: subject testingSubject]. - link: '[show tests]' action: [enterSubject:: subject inactiveTestingSubject]}. -) -respondToRunApp: paused = ( - (* bogus: The subject might not be in the root namespace. *) - | appConfig manifest platform args thread | - appConfig:: ide namespacing Root at: subject name. - manifest:: ide namespacing manifest. - platform:: cachedPlatform. - args:: {}. - thread:: platform mirrors ActivationMirror invokeSuspended: - [(appConfig packageUsing: manifest) main: platform args: args]. - paused ifFalse: [thread resume]. - thread isFulfilled ifFalse: - [enterSubject:: ide debugging ThreadSubject onModel: thread]. -) -runAppAction = ( - subject isApplicationConfiguration ifFalse: [^nothing]. - ^row: { - link: '[run]' action: [respondToRunApp: false]. - link: '[debug]' action: [respondToRunApp: true]. - } -) definition = ( ^(row: { testActions. @@ -204,7 +233,53 @@ definition = ( }) mainAxisAlignToEnd. ) -editDeploymentsAction = ( +future_deployAction = ( +(* Eventually, we'll use the deployment manager for deployment. + At that point, this method will replace the current #deployAction + implementation. Alas, this will take a while, as we need to implement + a general strategy for reconstituting serialized aliens for this to work. +*) + subject isApplicationConfiguration ifFalse: [^nothing]. + ^link: '[deploy]' action: [ + openMenu:: menuWithLabelsAndActions: ( + ide deployment configurations collect: [:dc | + {'to ', dc name. + [ide deployment deploy: (ide namespacing Root at: subject name) on: dc]}] + ) + ] +) +respondToRunTests = ( + | thread | + thread:: cachedPlatform mirrors ActivationMirror invokeSuspended: + [enterSubject:: subject testingSubject]. + thread resume. + thread isFulfilled + ifFalse: + [enterSubject:: ide debugging ThreadSubject onModel: thread]. +) +respondToShowTests = ( + | thread | + thread:: cachedPlatform mirrors ActivationMirror invokeSuspended: + [enterSubject:: subject inactiveTestingSubject]. + thread resume. + thread isFulfilled + ifFalse: + [enterSubject:: ide debugging ThreadSubject onModel: thread]. +) +public testActions = ( + subject isTestConfiguration ifFalse: [^nothing]. + ^row: { + link: '[run tests]' action: [respondToRunTests]. + link: '[show tests]' action: [respondToShowTests]}. +) +public runAppAction = ( + subject isApplicationConfiguration ifFalse: [^nothing]. + ^row: { + link: '[run]' action: [respondToRunApp: false]. + link: '[debug]' action: [respondToRunApp: true]. + } +) +public editDeploymentsAction = ( | DeploymentConfigurationSubject = ide deployment DeploymentConfigurationSubject. | subject isApplicationConfiguration ifFalse: [^nothing]. ^link: '[configurations]' action: [ @@ -214,46 +289,57 @@ editDeploymentsAction = ( {{'Create New Deployment'. [enterSubject:: DeploymentConfigurationSubject onModel: ide deployment defaultConfiguration]}} ] ) -deployAsVictoryFuel = ( - | bytes = subject bytesForVictoryFuel. | - ide webFiles downloadFileName: subject name, '.vfuel' fromBytes: bytes. +respondToRunApp: paused = ( + subject runApp: paused ) -deployAsVictoryFuelWithMirrors = ( - | bytes = subject bytesForVictoryFuelWithMirrors. | - ide webFiles downloadFileName: subject name, '.vfuel' fromBytes: bytes. +deployAsNSO = ( + subject deployAsNSO ) -deployAction = ( +public deployAction = ( subject isApplicationConfiguration ifFalse: [^nothing]. ^(link: '[deploy]' action: [ openMenu:: menuWithLabelsAndActions: { + {'as Newspeak Object (NSO)'. [deployAsNSO]}. {'as VictoryFuel'. [deployAsVictoryFuel]}. - {'as VictoryFuel with Mirrors'. [deployAsVictoryFuelWithMirrors]}. + {'as VictoryFuel with Mirrors'. [deployAsVictoryFuelWithMirrors]}. + {'as VictoryFuel with Hopscotch'. [deployAsVictoryFuelWithHopscotch]}. {'as Web Page'. [deployAsWebPage]}. {'as Web Page with Mirror Builders'. [deployAsWebPageWithMirrorBuilders]}. } ]). ) -future_deployAction = ( -(* Eventually, we'll use the deployment manager for deployment. - At that point, this method will replace the current #deployAction - implementation. Alas, this will take a while, as we need to implement - a general strategy for reconstituting serialized aliens for this to work. -*) - subject isApplicationConfiguration ifFalse: [^nothing]. - ^link: '[deploy]' action: [ - openMenu:: menuWithLabelsAndActions: ( - ide deployment configurations collect: [:dc | - {'to ', dc name. - [ide deployment deploy: (ide namespacing Root at: subject name) on: dc]}] - ) - ] +deployAsWebPage = ( + deployAsWebPageWithRuntimeConfig: ide deployment Runtime +) +deployAsWebPageWithMirrorBuilders = ( + deployAsWebPageWithRuntimeConfig: ide deployment RuntimeWithMirrorBuilders +) +deployAsWebPageWithRuntimeConfig: runtimeClass = ( +| +deployment = + (ide deployment jsPackagerForPlatform: cachedPlatform) + packageApplicationConfiguration: (ide namespacing Root at: subject name) + withRuntimeConfiguration: runtimeClass + usingNamespace: ide namespacing Root. +| + (* Now zip deployment and download it. Maybe try and open the URI afterwards *) + deployment save. + ) +deployAsVictoryFuelWithMirrors = ( + | bytes = subject bytesForVictoryFuelWithMirrors. | + ide webFiles downloadFileName: subject name, '.vfuel' fromBytes: bytes. +) +deployAsVictoryFuelWithHopscotch = ( + | bytes = subject bytesForVictoryFuelWithHopscotch. | + ide webFiles downloadFileName: subject name, '.vfuel' fromBytes: bytes. +) +deployAsVictoryFuel = ( + | bytes = subject bytesForVictoryFuel. | + ide webFiles downloadFileName: subject name, '.vfuel' fromBytes: bytes. ) ) : ( ) class ClassEntryPresenter onSubject: s = EntryPresenter onSubject: s () ( -accessIndicator = ( - ^image: (iconForAccessModifier: subject accessModifier) size: styleButtonSize. -) classCommentSummary ^ = ( | fullComment = subject classCommentText. @@ -262,23 +348,29 @@ classCommentSummary ^ = ( | ^firstSentence ) -entryActionsMenu = ( - ^nothing -) expandedDefinition = ( ^subject presenter ) public tag ^ = ( ^subject name ) +public isKindOfClassEntryPresenter ^ = ( + ^true +) +isMyKind: f ^ = ( + ^f isKindOfClassEntryPresenter +) collapsedDefinition = ( - ^row1: { + ^column: { + helpSection. + row1: { defaultBlank. - image: ide images classIcon size: styleButtonSize. + (image: ide images classImage) + height: styleButtonSize. defaultBlank. accessIndicator. defaultBlank. - link: subject name action: [enterSubject:: ClassSubject onModel: subject classMirror]. + link: tag action: [enterSubject:: ClassSubject onDeclaration: subject classMirror]. } row2: { (row: {deferred: [(label: subject classCommentSummary) smallFont; @@ -286,11 +378,52 @@ collapsedDefinition = ( compressibility: 1. filler compressibility: 0. - + helpButton. + mediumBlank. (ClassActionsPresenter onSubject: subject) elasticity: 1. mediumBlank. entryActionsMenu. } + } +) +respondToDelete = ( + | enclosing = subject enclosingClassSubject. | + updateGUI: [ + subject deleteClass. + ] +) +entryActionsMenu = ( + ^dropDownMenu: [ + menuWithLabelsAndActions: { + {'Inspect Presenter'. [respondToInspectPresenter]}. + #separator. + {'Delete '. [respondToDelete]}. + }] +) +helpText = ( + | + mapping = Map new. + menuImage = Utilities uriForIconNamed: #dropDownImage. + referenceImage = Utilities uriForIconNamed: #itemReferencesImage. + goldenIcon = Utilities uriForIconNamed: #classImage. + | + mapping + at: #hopscotchToggleEntry put: (collapsed: [defaultBlank] expanded: [expandedDefinition]); + at: #className put: (link: tag action: [enterSubject:: subject]); + at: #hopscotchEntryMenuButton put: entryActionsMenu; + at: #hopscotchMethodReferencesButton put: (dropDownMenu: [messagesMenu] image: ide images itemReferencesImage); + at: #hopscotchHelpButton put: helpButton. + + ^ampleforth: 'This is a class entry presenter, representing a nested class. Below, you see, from left to right: +
    +
  • The icon identifying this entry as a class. +
  • The class name
    If you click on it, the system will open a presenter on the class. This will be either a class presenter, or an object presenter on an exemplar of the class (if the system can find one). You can also expand a presenter on the class in place using the toggle
    at the top left of this entry.
    • +
  • A summary of their class comment, if any.
    • +
  • Shows this help message.
    • +
  • Opens a menu of additional operations, such as deleting this class from the enclosing class or inspecting this presenter.
    • +
+ ' + mapping: mapping ) ) : ( ) @@ -303,14 +436,6 @@ changeResponse ^ <[:CodeMirrorFragment :Event]> = ( colorizeHeaderSource: (crToLf: ed textBeingAccepted) withEditor: ed. ] ) -collapsedDefinition ^ = ( - ^column: { - headerDefinition. - label: subject classCommentSummary. - mediumBlank. - slotList. - } -) colorizeHeaderSource: s withEditor: cm = ( ide colorizer colorizeHeader: s fromClass: subject classMirror via: (colorizingBlockFor: cm) ) @@ -319,27 +444,6 @@ definition = ( expanded: [expandedDefinition]. ^toggle ) -expandedDefinition = ( - ^column: { - headerDefinition. - editorDefinition. - } -) -headerDefinition ^ = ( - ^row: { - defaultBlank. - image: (iconForAccessModifier: subject accessModifier) size: styleButtonSize. - defaultBlank. - (link: subject name action: [toggle toggle]) color: actionLinkColor. - showClassName - ifTrue: [nestingInformationLine] - ifFalse: [nothing]. - filler. - dropDownMenu: [messagesMenu] image: ide images itemReferencesImage. - smallBlank. - dropDownMenu: [methodMenuFor: subject name] - }. -) public isKindOfClassFactoryPresenter ^ = ( ^true ) @@ -356,28 +460,6 @@ nestingInformationLine ^ = ( rowElements add: (linkToBrowseEnclosingClass: each)]. ^row: rowElements asArray ) -slotList ^ = ( - | sl | - ^column: { - (sl:: subject classMirror instanceSide slots) size > 0 - ifTrue: [ - column: { - label: 'Slots' weight: #bold. - smallBlank. - row: { - (column: (sl collect: [:ea | - row: { - defaultBlank. - image: (iconForAccessModifier: ea accessModifier) size: styleButtonSize. - defaultBlank. - label: ea name. - } - ])) elasticity: 1. - } - }. - ] ifFalse: [nothing]. - } -) editorDefinition = ( | src = crToLf: subject classHeaderSource. @@ -409,9 +491,105 @@ acceptResponse ^ <[:CodeMirrorFragment :Event]> = ( ed editor focus. ] ) +slotList ^ = ( + | sl | + ^column: { + (sl:: subject classMirror instanceSide slots) size > 0 + ifTrue: [ + column: { + (label: 'Slots') + bold. + smallBlank. + row: { + (column: (sl collect: [:ea | + row: { + defaultBlank. + accessIndicator: ea accessModifier. + defaultBlank. + label: ea name. + } + ])) elasticity: 1. + } + }. + ] ifFalse: [nothing]. + } +) +collapsedDefinition ^ = ( + ^column: { + helpSection. + headerDefinition. + label: subject classCommentSummary. + mediumBlank. + slotList. + } +) +expandedDefinition = ( + ^column: { + helpSection. + headerDefinition. + editorDefinition. + } +) +headerDefinition ^ = ( + ^row: { + defaultBlank. + accessIndicator. + defaultBlank. + (link: subject name action: [toggle toggle]) color: actionLinkColor. + showClassName + ifTrue: [nestingInformationLine] + ifFalse: [nothing]. + filler. + (* Disabled for now. The story is a bit more complex for factory debugging. + deferred: [debugButton]. + smallBlank.*) + dropDownMenu: [messagesMenu] image: ide images itemReferencesImage. + smallBlank. + helpButton. + smallBlank. + dropDownMenu: [methodMenuFor: subject name] + }. +) +helpText = ( + | + mapping = Map new. + menuImage = Utilities uriForIconNamed: #dropDownImage. + referenceImage = Utilities uriForIconNamed: #itemReferencesImage. + exemplarHeaderDescription = + hasExemplars + ifTrue: ['
  • Opens a debugger on an invocation of the method, with the arguments given by the method exemplar.
    • '] ifFalse: ['']. + menuDescription = + hasExemplars + ifTrue: ['deleting the method, inspecting this presenter or opening an evaluator.'] ifFalse: ['deleting the method or inspecting this presenter.']. + editorEvaluatorDescription = + hasExemplars + ifTrue: ['
    The editor is also an evaluator. See it''s help section for more details.'] ifFalse: ['']. + | + mapping + at: #hopscotchAccessIndicator put: accessIndicator; + at: #hopscotchMethodMenuButton put: (dropDownMenu: [methodMenu]); + at: #hopscotchDebugMethodButton put: debugButton; + at: #hopscotchMethodReferencesButton put: (dropDownMenu: [messagesMenu] image: ide images itemReferencesImage); + at: #hopscotchHelpButton put: helpButton. + + ^ampleforth: 'This is a class factory method presenter. It can be either expanded or collapsed. In the collapsed state, the factory header is shown. +

    From left to right, the factory header displays: +
      +
    • The factory''s access modifier. It is always green, as Newspeak primary factories are public by definition.
      • +
    • The factory method selector.
      • ', exemplarHeaderDescription, + '
    • Allows you to find senders and implementors of the factory method''s selector and of its slot accessors.
      • +
    • Shows this help message.
      • +
    • Opens a menu of additional operations, such as ', menuDescription, '
      • +
    + Below the header we see the first sentence of the class comment, and below that a list of the classes'' slots. Each slot is prefixed by its access modifier. The color of the access modifier indicates whether the slot is public (green), protected (yellow) or private (red). +

    + When the factory method presenter is expanded, an editor pane containing the factory source is displayed underneath the header. You can edit the source, allowing you change the factory name, the superclass clauses, and to add, remove or modify slot declarations and any other factory code. Once the code is changed, indicators appear at the top right corner of the editor pane. You can accept the changes by pressing, or revert back to the original by pressing . You can also accept changes by pressing Cmd-return (on mac) or Ctl-return (on Linux or Windows). + ', editorEvaluatorDescription + mapping: mapping +) ) : ( ) -class ClassFactorySubject onModel: m = MethodSubject onModel: m ( +class ClassFactorySubject onClassModel: m = MethodSubject onMethodModel: m ( ) ( public accessModifier ^ = ( ^#public @@ -430,13 +608,13 @@ classCommentText ^ = ( ^comment ) public classDeclaration ^ = ( - ^model + ^classMirror ) public classHeaderSource = ( ^classMirror header source ) public classMirror ^ = ( - ^model + ^model klass ) public createPresenter ^ = ( ^ClassFactoryPresenter onSubject: self @@ -444,51 +622,60 @@ public createPresenter ^ = ( public delete = ( Error signal: 'cannot delete primary class factory' ) -public enclosingClasses ^ = ( -(* Returns all classes the model is nested in, beginning with the immediately enclosing class and up to the top level. *) - | - classes = List new. - currentClass ::= classMirror. - | - [currentClass isNil] - whileFalse: [ - classes add: currentClass. - currentClass:: currentClass enclosingClass - ]. - ^classes -) -public isKindOfClassFactorySubject ^ = ( - true -) isMyKind: s ^ = ( ^s isKindOfClassFactorySubject ) +public name ^ = ( + ^classMirror primaryFactorySelector +) +public isKindOfClassFactorySubject ^ = ( + ^true +) +public metadata ^ = ( + ^classMirror header metadata +) +public primaryFactorySelector ^ = ( + ^classMirror primaryFactorySelector +) +public source ^ = ( + ^classHeaderSource +) +public enclosingClassScope ^ = ( + (* Produce an object that will serve as the enclosing scope when debugging the factory live *) + | enclosing = enclosingScope. | + #BOGUS. + enclosing isNil ifTrue: [^nil]. + enclosing getClass enclosingObject reflectee isNil ifTrue: [(* return ide scope *) ^hiddenWorkspace]. + ^enclosing getClass enclosingObject +) +public enclosingScope ^ = ( + #BOGUS. +) public messages ^ = ( | result = List new. | - #BOGUS yourself. classMirror instanceSide slots do: [:slot | result add: slot name. slot isMutable ifTrue: [result add: slot name, ':'] ]. -(*TODO: extract messages from factory. - *) + classMirror header selectors do: [:message | + (result indexOf: message) = 0 ifTrue: [result add: message] + ]. ^result ) -public name ^ = ( - ^classMirror primaryFactorySelector -) ) : ( +public onModel: m = ( + ^onClassModel: (ClassModel declaration: m exemplar: nil) +) ) class ClassPresenter onSubject: s = ProgrammingPresenter onSubject: s ( | + public lazySlotsPresenter public nestedClassesPresenter public instanceMethodsPresenter public classMethodsPresenter + classActionsPresenter ::= (ClassActionsPresenter onSubject: subject) elasticity: 1. | ) ( -accessIndicator = ( - ^image: (iconForAccessModifier: subject accessModifier) size: styleButtonSize. -) changeResponse ^ <[:CodeMirrorFragment :Event]> = ( ^[:ed :event | colorizeHeaderSource: (crToLf: ed textBeingAccepted) withEditor: ed. @@ -566,16 +753,6 @@ minorClassHeadingColor = ( from: (Color h: 240 s: 0.02 v: 0.94) to: (Color h: 240 s: 0.02 v: 0.9) ) -nestedClass: cdm = ( - ^collapsed: [row: { - defaultBlank. - image: (iconForAccessModifier: cdm accessModifier) size: styleButtonSize. - defaultBlank. - link: cdm simpleName action: [enterSubject:: ClassSubject onModel: cdm] - } - ] - expanded: [(ClassSubject onModel: cdm) presenter] -) preambleLine = ( (* The line showing the class constructor syntax, e.g. 'Foo foo: x = Bar'. The superclass clause, if present, becomes a link to browse the superclass. *) @@ -607,13 +784,6 @@ respondToDelete = ( ifTrue: [enterSubject: NamespaceSubject new] ] ) -public addMethodTemplate: t = ( - subject methodsSubject presenter addNewItemTemplate: t. - refresh -) -respondToSave = ( - ide webFiles downloadFileName: subject name, '.ns' fromString: subject compilationUnitSource. -) acceptResponse ^ <[:CodeMirrorFragment :Event]> = ( ^[:ed :event | | b = subject classMirror asBuilder. | @@ -624,6 +794,16 @@ acceptResponse ^ <[:CodeMirrorFragment :Event]> = ( ed leaveEditState. ] ) +nestedClass: cdm = ( + ^collapsed: [row: { + defaultBlank. + accessIndicator. + defaultBlank. + link: cdm simpleName action: [enterSubject:: ClassSubject onDeclaration: cdm] + } + ] + expanded: [(ClassSubject onModel: cdm) presenter] +) classNameAndHierarchySummary = ( | parts | parts:: List new. @@ -633,11 +813,12 @@ classNameAndHierarchySummary = ( ^column: { row: { smallBlank. - image: ide images classIcon size: styleButtonSize. + (image: ide images classImage) + height: styleButtonSize. smallBlank. row: parts. filler. - (ClassActionsPresenter onSubject: subject) elasticity: 1. + classActionsPresenter. smallBlank. itemReferencesButtonWithAction: [browseSelector: subject name]. smallBlank. @@ -651,29 +832,46 @@ classNameAndHierarchySummary = ( } } ) -public definition ^ = ( - ^column: { - helpSection. - headingDefinition. - nestedClassesPresenter:: subject nestedClassesSubject presenter. - instanceMethodsPresenter:: subject methodsSubject presenter. - classMethodsPresenter:: subject classMethodsSubject presenter. - } -) helpText ^ = ( | mapping = Map new. - menuImage = Utilities uriForIconNamed: #hsDropdownImage. + menuImage = Utilities uriForIconNamed: #dropDownImage. referenceImage = Utilities uriForIconNamed: #itemReferencesImage. + classActions = classActionsPresenter. + appActionsHelp = + subject isApplicationConfiguration ifTrue: [ + mapping + at: #classDeployAction put: classActions deployAction; + at: #classEditDeploymentsAction put: classActions editDeploymentsAction; + at: #classRunAppAction put: classActions runAppAction. + 'Next, because this is a application configuration class, come links for managing application configurations +
      +
    • Bring up a menu of options for deploying this application configuration
      • +
    • Add or modify deployment options.
      • +
    • Run or debug the app.
      • +
    ' + ] ifFalse: ['']. + testActionsHelp = + subject isTestConfiguration ifTrue: [ + mapping + at: #classTestActions put: classActions testActions. + ' Next, because this is a test configuration class, come links
    for running or displaying the tests for this test configuration.' + ] ifFalse: ['']. | - mapping + subject isApplicationConfiguration ifTrue: [ + ] ifFalse: []. + mapping + at: #classTestActions put: classActions testActions; + at: #classDeployAction put: classActions deployAction; + at: #classEditDeploymentsAction put: classActions editDeploymentsAction; + at: #classRunAppAction put: classActions runAppAction; at: #hopscotchClassActionsMenuButton put: (dropDownMenu: [classActionsMenu]); at: #hopscotchClassReferencesButton put: (itemReferencesButtonWithAction: [browseSelector: subject name]); at: #hopscotchHelpButton put: helpButton; at: #hopscotchRefreshButton put: refreshButton; at: #hopscotchSaveButton put: (saveButtonWithAction: [respondToSave]). - ^ampleforth: 'A class presenter provides a structured view of a class. The first line tells you the class name and what classes, if any, it is nested in. It also provides the following buttons: + ^ampleforth: 'A class presenter provides a structured view of a class. The first line tells you the class name and what classes, if any, it is nested in. ', appActionsHelp, testActionsHelp, ' The class presenter also provides the following buttons: