Platform-ImportExport.st 28 KB

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