Platform-ImportExport.st 29 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210
  1. Smalltalk createPackage: 'Platform-ImportExport'!
  2. Object subclass: #AbstractExporter
  3. slots: {}
  4. package: 'Platform-ImportExport'!
  5. !AbstractExporter commentStamp!
  6. I am an abstract exporter for Amber source code.
  7. ## API
  8. Use `#exportPackage:on:` to export a given package on a Stream.!
  9. !AbstractExporter methodsFor: 'accessing'!
  10. extensionMethodsOfPackage: aPackage
  11. | result |
  12. result := OrderedCollection new.
  13. (self extensionProtocolsOfPackage: aPackage) do: [ :each |
  14. result addAll: each ownMethods ].
  15. ^ result
  16. !
  17. extensionProtocolsOfPackage: aPackage
  18. | extensionName result |
  19. extensionName := '*', aPackage name.
  20. result := OrderedCollection new.
  21. "The classes must be loaded since it is extensions only.
  22. Therefore topological sorting (dependency resolution) does not matter here.
  23. Not sorting topologically improves the speed by a number of magnitude.
  24. Not to shuffle diffs, classes are sorted by their name."
  25. (Smalltalk classes asArray sorted: [ :a :b | a name < b name ]) do: [ :each |
  26. each includingPossibleMetaDo: [ :behavior |
  27. (behavior protocols includes: extensionName) ifTrue: [
  28. result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
  29. ^ result
  30. ! !
  31. !AbstractExporter methodsFor: 'output'!
  32. exportPackage: aPackage on: aStream
  33. self subclassResponsibility
  34. ! !
  35. AbstractExporter subclass: #ChunkExporter
  36. slots: {}
  37. package: 'Platform-ImportExport'!
  38. !ChunkExporter commentStamp!
  39. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  40. I do not output any compiled code.!
  41. !ChunkExporter methodsFor: 'accessing'!
  42. extensionCategoriesOfPackage: aPackage
  43. "Issue #143: sort protocol alphabetically"
  44. | name map result |
  45. name := aPackage name.
  46. result := OrderedCollection new.
  47. (Package sortedClasses: Smalltalk classes) do: [ :each |
  48. each includingPossibleMetaDo: [ :aClass |
  49. map := Dictionary new.
  50. aClass protocolsDo: [ :category :methods |
  51. category = ('*', name) ifTrue: [ map at: category put: methods ] ].
  52. result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |
  53. MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].
  54. ^ result
  55. !
  56. ownCategoriesOfClass: aClass
  57. "Answer the protocols of aClass that are not package extensions"
  58. "Issue #143: sort protocol alphabetically"
  59. | map |
  60. map := Dictionary new.
  61. aClass protocolsDo: [ :each :methods |
  62. (each match: '^\*') ifFalse: [ map at: each put: methods ] ].
  63. ^ (map keys sorted: [ :a :b | a <= b ]) collect: [ :each |
  64. MethodCategory name: each theClass: aClass methods: (map at: each) ]
  65. !
  66. ownCategoriesOfMetaClass: aClass
  67. "Issue #143: sort protocol alphabetically"
  68. ^ self ownCategoriesOfClass: aClass theMetaClass
  69. !
  70. ownMethodProtocolsOfClass: aClass
  71. "Answer a collection of ExportMethodProtocol object of aClass that are not package extensions"
  72. ^ aClass ownProtocols collect: [ :each |
  73. ExportMethodProtocol name: each theClass: aClass ]
  74. ! !
  75. !ChunkExporter methodsFor: 'convenience'!
  76. chunkEscape: aString
  77. "Replace all occurrences of !! with !!!! and trim at both ends."
  78. ^ (aString replace: '!!' with: '!!!!') trimBoth
  79. ! !
  80. !ChunkExporter methodsFor: 'output'!
  81. exportBehavior: aBehavior on: aStream
  82. aBehavior exportBehaviorDefinitionTo: aStream using: self.
  83. self
  84. exportProtocols: (self ownMethodProtocolsOfClass: aBehavior)
  85. on: aStream
  86. !
  87. exportCategoryEpilogueOf: aCategory on: aStream
  88. aStream write: ' !!'; lf; lf
  89. !
  90. exportCategoryPrologueOf: aCategory on: aStream
  91. aStream
  92. write: '!!';
  93. print: aCategory theClass;
  94. write: ' methodsFor: ';
  95. print: aCategory;
  96. write: '!!'
  97. !
  98. exportDefinitionOf: aClass on: aStream
  99. "Chunk format."
  100. aStream
  101. print: aClass superclass;
  102. write: ' subclass: ';
  103. printSymbol: aClass name;
  104. lf.
  105. "aClass traitComposition
  106. ifNotEmpty: [ aStream tab; write: {'uses: '. aClass traitCompositionDefinition}; lf ]."
  107. aStream
  108. tab;
  109. write: {'slots: {'. ('. ' join: (aClass instanceVariableNames collect: #symbolPrintString)). '}'};
  110. lf;
  111. tab;
  112. write: 'package: ';
  113. print: aClass category;
  114. write: '!!';
  115. lf.
  116. aClass comment ifNotEmpty: [ aStream
  117. write: '!!'; print: aClass; write: ' commentStamp!!'; lf;
  118. write: { self chunkEscape: aClass comment. '!!' }; lf ].
  119. aStream lf
  120. !
  121. exportMetaDefinitionOf: aClass on: aStream
  122. | classIvars classTraitComposition |
  123. classIvars := aClass class instanceVariableNames.
  124. classTraitComposition := aClass class traitComposition.
  125. (classIvars notEmpty "or: [classTraitComposition notEmpty]") ifTrue: [
  126. aStream
  127. print: aClass theMetaClass.
  128. aStream space. "classTraitComposition
  129. ifEmpty: [ aStream space ]
  130. ifNotEmpty: [ aStream lf; tab; write: {'uses: '. aClass class traitCompositionDefinition}; lf; tab ]."
  131. aStream
  132. write: {'slots: {'. ('. ' join: (classIvars collect: #symbolPrintString)). '}!!'}; lf; lf ]
  133. !
  134. exportMethod: aMethod on: aStream
  135. aStream
  136. lf; lf; write: (self chunkEscape: aMethod source); lf;
  137. write: '!!'
  138. !
  139. exportPackage: aPackage on: aStream
  140. self
  141. exportPackageDefinitionOf: aPackage on: aStream;
  142. exportPackageImportsOf: aPackage on: aStream.
  143. aPackage sortedClasses do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |
  144. self exportBehavior: each on: aStream ] ].
  145. self exportPackageTraitCompositionsOf: aPackage on: aStream.
  146. self
  147. exportProtocols: (self extensionProtocolsOfPackage: aPackage)
  148. on: aStream
  149. !
  150. exportPackageDefinitionOf: aPackage on: aStream
  151. aStream
  152. write: 'Smalltalk createPackage: ';
  153. print: aPackage name;
  154. write: '!!';
  155. lf
  156. !
  157. exportPackageImportsOf: aPackage on: aStream
  158. aPackage imports ifNotEmpty: [ :imports | aStream
  159. write: '(Smalltalk packageAt: ';
  160. print: aPackage name;
  161. write: ' ifAbsent: [ self error: ';
  162. print: 'Package not created: ', aPackage name;
  163. write: { ' ]) imports: '. self chunkEscape: aPackage importsDefinition. '!!' };
  164. lf ]
  165. !
  166. exportPackageTraitCompositionsOf: aPackage on: aStream
  167. aPackage traitCompositions ifNotEmpty: [ :traitCompositions |
  168. traitCompositions keysAndValuesDo: [ :key :value | self exportTraitComposition: value of: key on: aStream ].
  169. aStream write: '!! !!'; lf; lf ]
  170. !
  171. exportProtocol: aProtocol on: aStream
  172. aProtocol ownMethods ifNotEmpty: [ :methods |
  173. self exportProtocolPrologueOf: aProtocol on: aStream.
  174. methods do: [ :method |
  175. self exportMethod: method on: aStream ].
  176. self exportProtocolEpilogueOf: aProtocol on: aStream ]
  177. !
  178. exportProtocolEpilogueOf: aProtocol on: aStream
  179. aStream write: ' !!'; lf; lf
  180. !
  181. exportProtocolPrologueOf: aProtocol on: aStream
  182. aStream
  183. write: '!!';
  184. print: aProtocol theClass;
  185. write: ' methodsFor: ';
  186. print: aProtocol name;
  187. write: '!!'
  188. !
  189. exportProtocols: aCollection on: aStream
  190. aCollection do: [ :each |
  191. self exportProtocol: each on: aStream ]
  192. !
  193. exportTraitComposition: aTraitComposition of: aBehavior on: aStream
  194. aStream
  195. print: aBehavior;
  196. write: ' setTraitComposition: ';
  197. write: aBehavior traitCompositionDefinition;
  198. write: ' asTraitComposition!!';
  199. lf
  200. !
  201. exportTraitDefinitionOf: aClass on: aStream
  202. "Chunk format."
  203. aStream
  204. write: 'Trait named: '; printSymbol: aClass name; lf.
  205. "aClass traitComposition
  206. ifNotEmpty: [ aStream tab; write: {'uses: '. aClass traitCompositionDefinition}; lf ]."
  207. aStream
  208. tab; write: 'package: '; print: aClass category; write: '!!'; lf.
  209. aClass comment ifNotEmpty: [
  210. aStream
  211. write: '!!'; print: aClass; write: ' commentStamp!!'; lf;
  212. write: { self chunkEscape: aClass comment. '!!' }; lf ].
  213. aStream lf
  214. ! !
  215. AbstractExporter subclass: #Exporter
  216. slots: {}
  217. package: 'Platform-ImportExport'!
  218. !Exporter commentStamp!
  219. I am responsible for outputting Amber code into a JavaScript string.
  220. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  221. ## Use case
  222. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  223. !Exporter methodsFor: 'accessing'!
  224. ownMethodsOfClass: aClass
  225. "Issue #143: sort methods alphabetically"
  226. ^ ((aClass methodDictionary values) sorted: [ :a :b | a selector <= b selector ])
  227. reject: [ :each | (each protocol match: '^\*') ]
  228. !
  229. ownMethodsOfMetaClass: aClass
  230. "Issue #143: sort methods alphabetically"
  231. ^ self ownMethodsOfClass: aClass theMetaClass
  232. ! !
  233. !Exporter methodsFor: 'output'!
  234. exportBehavior: aBehavior on: aStream
  235. aBehavior exportBehaviorDefinitionTo: aStream using: self.
  236. aBehavior ownMethods do: [ :method |
  237. self exportMethod: method on: aStream ]
  238. !
  239. exportDefinitionOf: aClass on: aStream
  240. aStream
  241. lf;
  242. write: {
  243. '$core.addClass('.
  244. aClass name asJavaScriptSource. ', '.
  245. aClass superclass ifNil: [ 'null' ] ifNotNil: [ :superclass | superclass asJavaScriptSource ]. ', '.
  246. aClass instanceVariableNames asJavaScriptSource. ', '.
  247. aClass category asJavaScriptSource.
  248. ');' }.
  249. aClass comment ifNotEmpty: [
  250. aStream
  251. lf;
  252. write: '//>>excludeStart("ide", pragmas.excludeIdeData);'; lf;
  253. write: { aClass asJavaScriptSource. '.comment='. aClass comment crlfSanitized asJavaScriptSource. ';' }; lf;
  254. write: '//>>excludeEnd("ide");' ].
  255. aStream lf
  256. !
  257. exportMetaDefinitionOf: aClass on: aStream
  258. aStream lf.
  259. aClass theMetaClass instanceVariableNames ifNotEmpty: [ :classIvars | aStream
  260. write: { '$core.setSlots('. aClass theMetaClass asJavaScriptSource. ', '. classIvars asJavaScriptSource. ');' };
  261. lf ]
  262. !
  263. exportMethod: aMethod on: aStream
  264. aStream
  265. write: '$core.addMethod('; lf;
  266. write: '$core.method({'; lf;
  267. write: { 'selector: '. aMethod selector asJavaScriptSource. ',' }; lf;
  268. write: { 'protocol: '. aMethod protocol asJavaScriptSource. ',' }; lf.
  269. aMethod fn ifNotNil: [ :fn | aStream write: { 'fn: '. fn compiledSource. ',' }; lf ].
  270. aStream
  271. write: '//>>excludeStart("ide", pragmas.excludeIdeData);'; lf;
  272. write: { 'args: '. aMethod arguments asJavaScriptSource. ',' }; lf;
  273. write: { 'source: '. aMethod source asJavaScriptSource. ',' }; lf;
  274. write: { 'referencedClasses: '. aMethod referencedClasses asJavaScriptSource. ',' }; lf;
  275. write: '//>>excludeEnd("ide");'; lf;
  276. write: { 'pragmas: '. aMethod basicPragmas asJavaScriptSource. ',' }; lf;
  277. write: { 'messageSends: '. aMethod messageSends asJavaScriptSource }; lf;
  278. write: '}'.
  279. aMethod fn ifNil: [ aStream write: { ', '. aMethod instantiateFn compiledSource } ].
  280. aStream
  281. write: '),'; lf;
  282. write: { aMethod origin asJavaScriptSource. ');' }; lf; lf
  283. !
  284. exportPackage: aPackage on: aStream
  285. self
  286. exportPackagePrologueOf: aPackage on: aStream;
  287. exportPackageDefinitionOf: aPackage on: aStream;
  288. exportPackageContextOf: aPackage on: aStream;
  289. exportPackageImportsOf: aPackage on: aStream;
  290. exportPackageTransportOf: aPackage on: aStream.
  291. aPackage sortedClasses do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |
  292. self exportBehavior: each on: aStream ] ].
  293. self exportPackageTraitCompositionsOf: aPackage on: aStream.
  294. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  295. self exportMethod: each on: aStream ].
  296. self exportPackageEpilogueOf: aPackage on: aStream
  297. !
  298. exportPackageBodyBlockPrologueOf: aPackage on: aStream
  299. aStream
  300. write: 'var $core=$boot.api,nil=$boot.nilAsValue,$nil=$boot.nilAsReceiver,$recv=$boot.asReceiver,$globals=$boot.globals;'; lf
  301. !
  302. exportPackageContextOf: aPackage on: aStream
  303. aStream
  304. write: '$pkg.innerEval = function (expr) { return eval(expr); };';
  305. lf
  306. !
  307. exportPackageDefinitionOf: aPackage on: aStream
  308. aStream
  309. write: { 'var $pkg = $core.addPackage('. aPackage name asJavaScriptSource. ');' };
  310. lf
  311. !
  312. exportPackageEpilogueOf: aPackage on: aStream
  313. self subclassResponsibility
  314. !
  315. exportPackageImportsOf: aPackage on: aStream
  316. aPackage importsAsJson ifNotEmpty: [ :imports |
  317. aStream
  318. write: { '$pkg.imports = '. imports asJavaScriptSource. ';' };
  319. lf ]
  320. !
  321. exportPackagePrologueOf: aPackage on: aStream
  322. self subclassResponsibility
  323. !
  324. exportPackageTraitCompositionsOf: aPackage on: aStream
  325. aPackage traitCompositions ifNotEmpty: [ :traitCompositions |
  326. traitCompositions keysAndValuesDo: [ :key :value | self exportTraitComposition: value of: key on: aStream ].
  327. aStream lf ]
  328. !
  329. exportPackageTransportOf: aPackage on: aStream
  330. aStream
  331. write: { '$pkg.transport = '. aPackage transport asJSONString. ';' };
  332. lf
  333. !
  334. exportTraitComposition: aTraitComposition of: aBehavior on: aStream
  335. aStream write: {
  336. '$core.setTraitComposition('.
  337. aTraitComposition asJavaScriptSource.
  338. ', '.
  339. aBehavior asJavaScriptSource.
  340. ');' };
  341. lf
  342. !
  343. exportTraitDefinitionOf: aClass on: aStream
  344. aStream
  345. lf;
  346. write: {
  347. '$core.addTrait('.
  348. aClass name asJavaScriptSource. ', '.
  349. aClass category asJavaScriptSource.
  350. ');' }.
  351. aClass comment ifNotEmpty: [
  352. aStream
  353. lf;
  354. write: '//>>excludeStart("ide", pragmas.excludeIdeData);'; lf;
  355. write: { aClass asJavaScriptSource. '.comment='. aClass comment crlfSanitized asJavaScriptSource. ';' }; lf;
  356. write: '//>>excludeEnd("ide");' ].
  357. aStream lf
  358. ! !
  359. Exporter subclass: #AmdExporter
  360. slots: {#namespace}
  361. package: 'Platform-ImportExport'!
  362. !AmdExporter commentStamp!
  363. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  364. !AmdExporter methodsFor: 'output'!
  365. exportPackageEpilogueOf: aPackage on: aStream
  366. aStream
  367. write: '});';
  368. lf
  369. !
  370. exportPackageImportsOf: aPackage on: aStream
  371. | importsForOutput pragmaStart pragmaEnd |
  372. pragmaStart := '//>>excludeStart("imports", pragmas.excludeImports);', String lf.
  373. pragmaEnd := '//>>excludeEnd("imports");', String lf.
  374. super exportPackageImportsOf: aPackage on: aStream.
  375. importsForOutput := self importsForOutput: aPackage.
  376. importsForOutput value ifNotEmpty: [ :imports |
  377. | vars |
  378. aStream write: pragmaStart.
  379. vars := importsForOutput key.
  380. vars ifNotEmpty: [ aStream write: { 'var '. ',' join: vars. ';' }; lf ].
  381. aStream
  382. write: {
  383. '$pkg.isReady = new Promise(function (resolve, reject) { requirejs('.
  384. imports asJavaScriptSource.
  385. ', function ('.
  386. ',' join: ((1 to: vars size) collect: [ :each | '$', each asString ]).
  387. ') {'.
  388. (1 to: vars size) collect: [ :each | (vars at: each), '=$', each asString, '; ' ].
  389. 'resolve();}, reject); });' };
  390. lf;
  391. write: pragmaEnd ]
  392. !
  393. exportPackagePrologueOf: aPackage on: aStream
  394. | loadDependencies pragmaStart pragmaEnd |
  395. pragmaStart := '//>>excludeStart("imports", pragmas.excludeImports);', String lf.
  396. pragmaEnd := '//>>excludeEnd("imports");', String lf.
  397. loadDependencies := self amdNamesOfPackages: aPackage loadDependencies.
  398. aStream
  399. write: {
  400. 'define('.
  401. (#('amber/boot' 'require'), loadDependencies asArray sorted) asJavaScriptSource.
  402. ', function($boot,requirejs){"use strict";' };
  403. lf.
  404. self exportPackageBodyBlockPrologueOf: aPackage on: aStream
  405. ! !
  406. !AmdExporter methodsFor: 'private'!
  407. amdNamesOfPackages: anArray
  408. ^ (anArray
  409. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  410. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  411. !
  412. amdNamespaceOfPackage: aPackage
  413. ^ (aPackage transport type = 'amd')
  414. ifTrue: [ aPackage transport namespace ]
  415. ifFalse: [ nil ]
  416. !
  417. importsForOutput: aPackage
  418. "Returns an association where key is list of import variables
  419. and value is list of external dependencies, with ones imported as variables
  420. put at the beginning with same order as is in key.
  421. For example imports:{'jQuery'->'jquery'. 'bootstrap'} would yield
  422. #('jQuery') -> #('jquery' 'bootstrap')"
  423. | namedImports anonImports importVarNames |
  424. namedImports := #().
  425. anonImports := #().
  426. importVarNames := #().
  427. aPackage imports do: [ :each | each isString
  428. ifTrue: [ anonImports add: each ]
  429. ifFalse: [ namedImports add: each value.
  430. importVarNames add: each key ]].
  431. ^ importVarNames -> (namedImports, anonImports)
  432. ! !
  433. Object subclass: #ChunkParser
  434. slots: {#stream. #last}
  435. package: 'Platform-ImportExport'!
  436. !ChunkParser commentStamp!
  437. I am responsible for parsing aStream contents in the chunk format.
  438. ## API
  439. ChunkParser new
  440. stream: aStream;
  441. nextChunk!
  442. !ChunkParser methodsFor: 'accessing'!
  443. last
  444. ^ last
  445. !
  446. stream: aStream
  447. stream := aStream
  448. ! !
  449. !ChunkParser methodsFor: 'reading'!
  450. nextChunk
  451. "The chunk format (Smalltalk Interchange Format or Fileout format)
  452. is a trivial format but can be a bit tricky to understand:
  453. - Uses the exclamation mark as delimiter of chunks.
  454. - Inside a chunk a normal exclamation mark must be doubled.
  455. - A non empty chunk must be a valid Smalltalk expression.
  456. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  457. - The object created by the expression then takes over reading chunks.
  458. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  459. | char result chunk |
  460. result := '' writeStream.
  461. [ char := stream next.
  462. char notNil ] whileTrue: [
  463. char = '!!' ifTrue: [
  464. stream peek = '!!'
  465. ifTrue: [ stream next "skipping the escape double" ]
  466. ifFalse: [ ^ last := result contents trimBoth "chunk end marker found" ]].
  467. result nextPut: char ].
  468. ^ last := nil "a chunk needs to end with !!"
  469. ! !
  470. !ChunkParser class methodsFor: 'instance creation'!
  471. on: aStream
  472. ^ self new stream: aStream
  473. ! !
  474. Object subclass: #ClassCommentReader
  475. slots: {#class}
  476. package: 'Platform-ImportExport'!
  477. !ClassCommentReader commentStamp!
  478. I provide a mechanism for retrieving class comments stored on a file.
  479. See also `ClassCategoryReader`.!
  480. !ClassCommentReader methodsFor: 'accessing'!
  481. class: aClass
  482. class := aClass
  483. ! !
  484. !ClassCommentReader methodsFor: 'fileIn'!
  485. scanFrom: aChunkParser
  486. | chunk |
  487. chunk := aChunkParser nextChunk.
  488. chunk ifNotEmpty: [
  489. self setComment: chunk ].
  490. ! !
  491. !ClassCommentReader methodsFor: 'initialization'!
  492. initialize
  493. super initialize.
  494. ! !
  495. !ClassCommentReader methodsFor: 'private'!
  496. setComment: aString
  497. class comment: aString
  498. ! !
  499. Object subclass: #ClassProtocolReader
  500. slots: {#class. #category}
  501. package: 'Platform-ImportExport'!
  502. !ClassProtocolReader commentStamp!
  503. I provide a mechanism for retrieving class descriptions stored on a file in the Smalltalk chunk format.!
  504. !ClassProtocolReader methodsFor: 'accessing'!
  505. class: aClass category: aString
  506. class := aClass.
  507. category := aString
  508. ! !
  509. !ClassProtocolReader methodsFor: 'fileIn'!
  510. scanFrom: aChunkParser
  511. | chunk |
  512. [ chunk := aChunkParser nextChunk.
  513. chunk isEmpty ] whileFalse: [
  514. self compileMethod: chunk ]
  515. ! !
  516. !ClassProtocolReader methodsFor: 'initialization'!
  517. initialize
  518. super initialize.
  519. ! !
  520. !ClassProtocolReader methodsFor: 'private'!
  521. compileMethod: aString
  522. Compiler new install: aString forClass: class protocol: category
  523. ! !
  524. Object subclass: #ExportMethodProtocol
  525. slots: {#name. #theClass}
  526. package: 'Platform-ImportExport'!
  527. !ExportMethodProtocol commentStamp!
  528. I am an abstraction for a method protocol in a class / metaclass.
  529. I know of my class, name and methods.
  530. I am used when exporting a package.!
  531. !ExportMethodProtocol methodsFor: 'accessing'!
  532. methods
  533. ^ (self theClass methodsInProtocol: self name)
  534. sorted: [ :a :b | a selector <= b selector ]
  535. !
  536. name
  537. ^ name
  538. !
  539. name: aString
  540. name := aString
  541. !
  542. ownMethods
  543. ^ (self theClass ownMethodsInProtocol: self name)
  544. sorted: [ :a :b | a selector <= b selector ]
  545. !
  546. theClass
  547. ^ theClass
  548. !
  549. theClass: aClass
  550. theClass := aClass
  551. ! !
  552. !ExportMethodProtocol class methodsFor: 'instance creation'!
  553. name: aString theClass: aClass
  554. ^ self new
  555. name: aString;
  556. theClass: aClass;
  557. yourself
  558. ! !
  559. Object subclass: #Importer
  560. slots: {#lastSection. #lastChunk}
  561. package: 'Platform-ImportExport'!
  562. !Importer commentStamp!
  563. I can import Amber code from a string in the chunk format.
  564. ## API
  565. Importer new import: aString!
  566. !Importer methodsFor: 'accessing'!
  567. lastChunk
  568. ^ lastChunk
  569. !
  570. lastSection
  571. ^ lastSection
  572. ! !
  573. !Importer methodsFor: 'fileIn'!
  574. import: aStream
  575. | chunk result parser lastEmpty |
  576. parser := ChunkParser on: aStream.
  577. lastEmpty := false.
  578. lastSection := 'n/a, not started'.
  579. lastChunk := nil.
  580. [
  581. [ chunk := parser nextChunk.
  582. chunk isNil ] whileFalse: [
  583. chunk
  584. ifEmpty: [ lastEmpty := true ]
  585. ifNotEmpty: [
  586. lastSection := chunk.
  587. result := Compiler new evaluateExpression: chunk.
  588. lastEmpty
  589. ifTrue: [
  590. lastEmpty := false.
  591. result scanFrom: parser ]] ].
  592. lastSection := 'n/a, finished'
  593. ] on: Error do: [:e | lastChunk := parser last. e pass ].
  594. ! !
  595. Error subclass: #PackageCommitError
  596. slots: {}
  597. package: 'Platform-ImportExport'!
  598. !PackageCommitError commentStamp!
  599. I get signaled when an attempt to commit a package has failed.!
  600. Object subclass: #PackageHandler
  601. slots: {}
  602. package: 'Platform-ImportExport'!
  603. !PackageHandler commentStamp!
  604. I am responsible for handling package loading and committing.
  605. I should not be used directly. Instead, use the corresponding `Package` methods.!
  606. !PackageHandler methodsFor: 'accessing'!
  607. chunkContentsFor: aPackage
  608. ^ String streamContents: [ :str |
  609. self chunkExporter exportPackage: aPackage on: str ]
  610. !
  611. chunkExporterClass
  612. ^ ChunkExporter
  613. !
  614. commitPathJsFor: aPackage
  615. self subclassResponsibility
  616. !
  617. commitPathStFor: aPackage
  618. self subclassResponsibility
  619. !
  620. contentsFor: aPackage
  621. ^ String streamContents: [ :str |
  622. self exporter exportPackage: aPackage on: str ]
  623. !
  624. exporterClass
  625. self subclassResponsibility
  626. !
  627. setPath: aString forPackage: aPackage
  628. self subclassResponsibility
  629. ! !
  630. !PackageHandler methodsFor: 'committing'!
  631. commit: aPackage
  632. self
  633. commit: aPackage
  634. onSuccess: []
  635. onError: [ :error |
  636. PackageCommitError new
  637. messageText: 'Commiting failed with reason: "' , (error responseText) , '"';
  638. signal ]
  639. !
  640. commit: aPackage onSuccess: aBlock onError: anotherBlock
  641. self
  642. commitJsFileFor: aPackage
  643. onSuccess: [
  644. self
  645. commitStFileFor: aPackage
  646. onSuccess: [ aPackage beClean. aBlock value ]
  647. onError: anotherBlock ]
  648. onError: anotherBlock
  649. !
  650. commitJsFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  651. self
  652. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  653. data: (self contentsFor: aPackage)
  654. onSuccess: aBlock
  655. onError: anotherBlock
  656. !
  657. commitStFileFor: aPackage onSuccess: aBlock onError: anotherBlock
  658. self
  659. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  660. data: (self chunkContentsFor: aPackage)
  661. onSuccess: aBlock
  662. onError: anotherBlock
  663. ! !
  664. !PackageHandler methodsFor: 'error handling'!
  665. onCommitError: anError
  666. PackageCommitError new
  667. messageText: 'Commiting failed with reason: "' , (anError responseText) , '"';
  668. signal
  669. ! !
  670. !PackageHandler methodsFor: 'factory'!
  671. chunkExporter
  672. ^ self chunkExporterClass new
  673. !
  674. exporter
  675. ^ self exporterClass new
  676. ! !
  677. !PackageHandler methodsFor: 'loading'!
  678. load: aPackage
  679. "Should return a TThenable"
  680. self subclassResponsibility
  681. ! !
  682. !PackageHandler methodsFor: 'private'!
  683. ajaxPutAt: aURL data: aString onSuccess: aBlock onError: anotherBlock
  684. | xhr |
  685. xhr := Platform newXhr.
  686. xhr open: 'PUT' url: aURL async: true.
  687. xhr onreadystatechange: [
  688. xhr readyState = 4 ifTrue: [
  689. (xhr status >= 200 and: [ xhr status < 300 ])
  690. ifTrue: aBlock
  691. ifFalse: anotherBlock ]].
  692. xhr send: aString
  693. ! !
  694. PackageHandler subclass: #AmdPackageHandler
  695. slots: {}
  696. package: 'Platform-ImportExport'!
  697. !AmdPackageHandler commentStamp!
  698. I am responsible for handling package loading and committing.
  699. I should not be used directly. Instead, use the corresponding `Package` methods.!
  700. !AmdPackageHandler methodsFor: 'accessing'!
  701. commitPathJsFor: aPackage
  702. ^ self toUrl: (self namespaceFor: aPackage)
  703. !
  704. commitPathStFor: aPackage
  705. "If _source is not mapped, .st will be committed to .js path.
  706. It is recommended not to use _source as it can be deprecated."
  707. | path pathWithout |
  708. path := self toUrl: (self namespaceFor: aPackage), '/_source'.
  709. pathWithout := self commitPathJsFor: aPackage.
  710. ^ path = (pathWithout, '/_source') ifTrue: [ pathWithout ] ifFalse: [ path ]
  711. !
  712. exporterClass
  713. ^ AmdExporter
  714. !
  715. setPath: aString forPackage: aPackage
  716. "Set the path the the package's `namespace`"
  717. "Smalltalk amdRequire
  718. ifNil: [ self error: 'AMD loader not present' ]
  719. ifNotNil: [ :require |"
  720. require provided config: #{
  721. 'paths' -> #{
  722. (self namespaceFor: aPackage) -> aString
  723. }
  724. }
  725. "]"
  726. ! !
  727. !AmdPackageHandler methodsFor: 'committing'!
  728. namespaceFor: aPackage
  729. ^ aPackage transport namespace
  730. ! !
  731. !AmdPackageHandler methodsFor: 'loading'!
  732. load: aPackage
  733. ^ Promise new: [ :model |
  734. Smalltalk amdRequire
  735. ifNil: [ self error: 'AMD loader not present' ]
  736. ifNotNil: [ :require |
  737. require
  738. value: { (self namespaceFor: aPackage), '/', aPackage name }
  739. value: [ :result | model value: result ]
  740. value: [ :error | model signal: error ] ] ]
  741. ! !
  742. !AmdPackageHandler methodsFor: 'private'!
  743. toUrl: aString
  744. ^ Smalltalk amdRequire
  745. ifNil: [ self error: 'AMD loader not present' ]
  746. ifNotNil: [ :require | require provided toUrl: aString ]
  747. ! !
  748. !AmdPackageHandler class methodsFor: 'commit paths'!
  749. defaultNamespace
  750. ^ Smalltalk defaultAmdNamespace
  751. !
  752. defaultNamespace: aString
  753. Smalltalk defaultAmdNamespace: aString
  754. ! !
  755. Object subclass: #PackageTransport
  756. slots: {#package}
  757. package: 'Platform-ImportExport'!
  758. !PackageTransport commentStamp!
  759. I represent the transport mechanism used to commit a package.
  760. My concrete subclasses have a `#handler` to which committing is delegated.!
  761. !PackageTransport methodsFor: 'accessing'!
  762. commitHandlerClass
  763. self subclassResponsibility
  764. !
  765. definition
  766. ^ ''
  767. !
  768. package
  769. ^ package
  770. !
  771. package: aPackage
  772. package := aPackage
  773. !
  774. type
  775. ^ self class type
  776. ! !
  777. !PackageTransport methodsFor: 'actions'!
  778. setPath: aString
  779. "Set the commit path for the package"
  780. self commitHandler setPath: aString forPackage: package
  781. ! !
  782. !PackageTransport methodsFor: 'committing'!
  783. commit
  784. self commitHandler commit: self package
  785. !
  786. commitOnSuccess: aBlock onError: anotherBlock
  787. self commitHandler
  788. commit: self package
  789. onSuccess: aBlock
  790. onError: anotherBlock
  791. ! !
  792. !PackageTransport methodsFor: 'converting'!
  793. asJavaScriptObject
  794. ^ #{ 'type' -> self type }
  795. ! !
  796. !PackageTransport methodsFor: 'factory'!
  797. commitHandler
  798. ^ self commitHandlerClass new
  799. ! !
  800. !PackageTransport methodsFor: 'initialization'!
  801. setupFromJson: anObject
  802. "no op. override if needed in subclasses"
  803. ! !
  804. !PackageTransport methodsFor: 'loading'!
  805. load
  806. ^ (self commitHandler load: self package)
  807. then: [ Smalltalk postLoad ]
  808. ! !
  809. PackageTransport class slots: {#registry}!
  810. !PackageTransport class methodsFor: 'accessing'!
  811. classRegisteredFor: aString
  812. ^ registry at: aString
  813. !
  814. defaultType
  815. ^ AmdPackageTransport type
  816. !
  817. type
  818. "Override in subclasses"
  819. ^ nil
  820. ! !
  821. !PackageTransport class methodsFor: 'initialization'!
  822. initialize
  823. super initialize.
  824. self == PackageTransport
  825. ifTrue: [ registry := #{} ]
  826. ifFalse: [ self register ]
  827. ! !
  828. !PackageTransport class methodsFor: 'instance creation'!
  829. for: aString
  830. ^ (self classRegisteredFor: aString) new
  831. !
  832. fromJson: anObject
  833. anObject ifNil: [ ^ self for: self defaultType ].
  834. ^ (self for: anObject type)
  835. setupFromJson: anObject;
  836. yourself
  837. ! !
  838. !PackageTransport class methodsFor: 'registration'!
  839. register
  840. PackageTransport register: self
  841. !
  842. register: aClass
  843. aClass type ifNotNil: [
  844. registry at: aClass type put: aClass ]
  845. ! !
  846. PackageTransport subclass: #AmdPackageTransport
  847. slots: {#namespace}
  848. package: 'Platform-ImportExport'!
  849. !AmdPackageTransport commentStamp!
  850. I am the default transport for committing packages.
  851. See `AmdExporter` and `AmdPackageHandler`.!
  852. !AmdPackageTransport methodsFor: 'accessing'!
  853. commitHandlerClass
  854. ^ AmdPackageHandler
  855. !
  856. definition
  857. ^ String streamContents: [ :stream | stream
  858. write: { self class name. ' namespace: ' }; print: self namespace ]
  859. !
  860. namespace
  861. ^ namespace ifNil: [ self defaultNamespace ]
  862. !
  863. namespace: aString
  864. namespace := aString
  865. ! !
  866. !AmdPackageTransport methodsFor: 'converting'!
  867. asJavaScriptObject
  868. ^ super asJavaScriptObject
  869. at: 'amdNamespace' put: self namespace;
  870. yourself
  871. ! !
  872. !AmdPackageTransport methodsFor: 'defaults'!
  873. defaultNamespace
  874. ^ Smalltalk defaultAmdNamespace
  875. ! !
  876. !AmdPackageTransport methodsFor: 'initialization'!
  877. setupFromJson: anObject
  878. self namespace: (anObject at: 'amdNamespace')
  879. ! !
  880. !AmdPackageTransport methodsFor: 'printing'!
  881. printOn: aStream
  882. super printOn: aStream.
  883. aStream
  884. nextPutAll: ' (AMD Namespace: ';
  885. nextPutAll: self namespace;
  886. nextPutAll: ')'
  887. ! !
  888. !AmdPackageTransport class methodsFor: 'accessing'!
  889. type
  890. ^ 'amd'
  891. ! !
  892. !AmdPackageTransport class methodsFor: 'instance creation'!
  893. namespace: aString
  894. ^ self new
  895. namespace: aString;
  896. yourself
  897. ! !
  898. !Class methodsFor: '*Platform-ImportExport'!
  899. exportBehaviorDefinitionTo: aStream using: anExporter
  900. anExporter exportDefinitionOf: self on: aStream
  901. ! !
  902. !Metaclass methodsFor: '*Platform-ImportExport'!
  903. exportBehaviorDefinitionTo: aStream using: anExporter
  904. anExporter exportMetaDefinitionOf: self instanceClass on: aStream
  905. ! !
  906. !Package methodsFor: '*Platform-ImportExport'!
  907. commit
  908. ^ self transport commit
  909. !
  910. load
  911. ^ self transport load
  912. !
  913. loadFromNamespace: aString
  914. ^ self transport
  915. namespace: aString;
  916. load
  917. ! !
  918. !Package class methodsFor: '*Platform-ImportExport'!
  919. load: aPackageName
  920. ^ (self named: aPackageName) load
  921. !
  922. load: aPackageName fromNamespace: aString
  923. ^ (self named: aPackageName) loadFromNamespace: aString
  924. ! !
  925. !TBehaviorProvider methodsFor: '*Platform-ImportExport'!
  926. methodsFor: aString
  927. ^ ClassProtocolReader new
  928. class: self category: aString;
  929. yourself
  930. !
  931. methodsFor: aString stamp: aStamp
  932. "Added for file-in compatibility, ignores stamp."
  933. ^ self methodsFor: aString
  934. ! !
  935. !TMasterBehavior methodsFor: '*Platform-ImportExport'!
  936. commentStamp
  937. ^ ClassCommentReader new
  938. class: self;
  939. yourself
  940. !
  941. commentStamp: aStamp prior: prior
  942. ^ self commentStamp
  943. ! !
  944. !Trait methodsFor: '*Platform-ImportExport'!
  945. exportBehaviorDefinitionTo: aStream using: anExporter
  946. anExporter exportTraitDefinitionOf: self on: aStream
  947. ! !