2
0

Importer-Exporter.st 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951
  1. Smalltalk current createPackage: 'Importer-Exporter'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Importer-Exporter'!
  5. !AbstractExporter commentStamp!
  6. I am an abstract exporter for Amber source code.!
  7. !AbstractExporter methodsFor: 'convenience'!
  8. chunkEscape: aString
  9. "Replace all occurrences of !! with !!!! and trim at both ends."
  10. ^(aString replace: '!!' with: '!!!!') trimBoth
  11. !
  12. classNameFor: aClass
  13. ^aClass isMetaclass
  14. ifTrue: [ aClass instanceClass name, ' class' ]
  15. ifFalse: [
  16. aClass isNil
  17. ifTrue: [ 'nil' ]
  18. ifFalse: [ aClass name ] ]
  19. ! !
  20. !AbstractExporter methodsFor: 'fileOut'!
  21. recipe
  22. "Recipe to export a given package."
  23. self subclassResponsibility
  24. ! !
  25. AbstractExporter class instanceVariableNames: 'default'!
  26. !AbstractExporter class methodsFor: 'instance creation'!
  27. default
  28. ^ default ifNil: [ default := self new ]
  29. ! !
  30. AbstractExporter subclass: #ChunkExporter
  31. instanceVariableNames: ''
  32. package: 'Importer-Exporter'!
  33. !ChunkExporter commentStamp!
  34. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  35. I do not output any compiled code.!
  36. !ChunkExporter methodsFor: 'accessing'!
  37. extensionCategoriesOfPackage: aPackage
  38. "Issue #143: sort protocol alphabetically"
  39. | name map result |
  40. name := aPackage name.
  41. result := OrderedCollection new.
  42. (Package sortedClasses: Smalltalk current classes) do: [:each |
  43. {each. each class} do: [:aClass |
  44. map := Dictionary new.
  45. aClass protocolsDo: [:category :methods |
  46. category = ('*', name) ifTrue: [ map at: category put: methods ]].
  47. result addAll: ((map keys sorted: [:a :b | a <= b ]) collect: [:category |
  48. MethodCategory name: category theClass: aClass methods: (map at: category)]) ]].
  49. ^result
  50. !
  51. methodsOfCategory: aCategory
  52. "Issue #143: sort methods alphabetically"
  53. ^(aCategory methods) sorted: [:a :b | a selector <= b selector]
  54. !
  55. ownCategoriesOfClass: aClass
  56. "Answer the protocols of aClassthat are not package extensions"
  57. "Issue #143: sort protocol alphabetically"
  58. | map |
  59. map := Dictionary new.
  60. aClass protocolsDo: [:category :methods |
  61. (category match: '^\*') ifFalse: [ map at: category put: methods ]].
  62. ^(map keys sorted: [:a :b | a <= b ]) collect: [:category |
  63. MethodCategory name: category theClass: aClass methods: (map at: category) ]
  64. !
  65. ownCategoriesOfMetaClass: aClass
  66. "Issue #143: sort protocol alphabetically"
  67. ^self ownCategoriesOfClass: aClass class
  68. ! !
  69. !ChunkExporter methodsFor: 'fileOut'!
  70. recipe
  71. "Export a given package."
  72. | exportCategoryRecipe |
  73. exportCategoryRecipe := {
  74. self -> #exportCategoryPrologueOf:on:.
  75. {
  76. self -> #methodsOfCategory:.
  77. self -> #exportMethod:on: }.
  78. self -> #exportCategoryEpilogueOf:on: }.
  79. ^{
  80. self -> #exportPackageDefinitionOf:on:.
  81. {
  82. PluggableExporter -> #ownClassesOfPackage:.
  83. self -> #exportDefinitionOf:on:.
  84. { self -> #ownCategoriesOfClass: }, exportCategoryRecipe.
  85. self -> #exportMetaDefinitionOf:on:.
  86. { self -> #ownCategoriesOfMetaClass: }, exportCategoryRecipe }.
  87. { self -> #extensionCategoriesOfPackage: }, exportCategoryRecipe
  88. }
  89. ! !
  90. !ChunkExporter methodsFor: 'output'!
  91. exportCategoryEpilogueOf: aCategory on: aStream
  92. aStream nextPutAll: ' !!'; lf; lf
  93. !
  94. exportCategoryPrologueOf: aCategory on: aStream
  95. aStream
  96. nextPutAll: '!!', (self classNameFor: aCategory theClass);
  97. nextPutAll: ' methodsFor: ''', aCategory name, '''!!'
  98. !
  99. exportDefinitionOf: aClass on: aStream
  100. "Chunk format."
  101. aStream
  102. nextPutAll: (self classNameFor: aClass superclass);
  103. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  104. tab; nextPutAll: 'instanceVariableNames: '''.
  105. aClass instanceVariableNames
  106. do: [:each | aStream nextPutAll: each]
  107. separatedBy: [aStream nextPutAll: ' '].
  108. aStream
  109. nextPutAll: ''''; lf;
  110. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  111. aClass comment notEmpty ifTrue: [
  112. aStream
  113. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  114. nextPutAll: (self chunkEscape: aClass comment), '!!';lf].
  115. aStream lf
  116. !
  117. exportMetaDefinitionOf: aClass on: aStream
  118. aClass class instanceVariableNames isEmpty ifFalse: [
  119. aStream
  120. nextPutAll: (self classNameFor: aClass class);
  121. nextPutAll: ' instanceVariableNames: '''.
  122. aClass class instanceVariableNames
  123. do: [:each | aStream nextPutAll: each]
  124. separatedBy: [aStream nextPutAll: ' '].
  125. aStream
  126. nextPutAll: '''!!'; lf; lf]
  127. !
  128. exportMethod: aMethod on: aStream
  129. aStream
  130. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  131. nextPutAll: '!!'
  132. !
  133. exportPackageDefinitionOf: aPackage on: aStream
  134. "Chunk format."
  135. aStream
  136. nextPutAll: 'Smalltalk current createPackage: ''', aPackage name, '''!!';
  137. lf
  138. ! !
  139. AbstractExporter subclass: #Exporter
  140. instanceVariableNames: ''
  141. package: 'Importer-Exporter'!
  142. !Exporter commentStamp!
  143. I am responsible for outputting Amber code into a JavaScript string.
  144. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  145. ## Use case
  146. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).
  147. ## API
  148. Use `#exportAll`, `#exportClass:` or `#exportPackage:` methods.!
  149. !Exporter methodsFor: 'accessing'!
  150. extensionMethodsOfPackage: aPackage
  151. "Issue #143: sort classes and methods alphabetically"
  152. | name result |
  153. name := aPackage name.
  154. result := OrderedCollection new.
  155. (Package sortedClasses: Smalltalk current classes) do: [:each |
  156. {each. each class} do: [:aClass |
  157. result addAll: (((aClass methodDictionary values)
  158. sorted: [:a :b | a selector <= b selector])
  159. select: [:method | method category = ('*', name)]) ]].
  160. ^result
  161. !
  162. ownMethodsOfClass: aClass
  163. "Issue #143: sort methods alphabetically"
  164. ^((aClass methodDictionary values) sorted: [:a :b | a selector <= b selector])
  165. reject: [:each | (each category match: '^\*')]
  166. !
  167. ownMethodsOfMetaClass: aClass
  168. "Issue #143: sort methods alphabetically"
  169. ^self ownMethodsOfClass: aClass class
  170. ! !
  171. !Exporter methodsFor: 'convenience'!
  172. classNameFor: aClass
  173. ^aClass isMetaclass
  174. ifTrue: [ aClass instanceClass name, '.klass' ]
  175. ifFalse: [
  176. aClass isNil
  177. ifTrue: [ 'nil' ]
  178. ifFalse: [ aClass name ] ]
  179. ! !
  180. !Exporter methodsFor: 'fileOut'!
  181. amdRecipe
  182. "Export a given package with amd transport type."
  183. | result |
  184. result := self recipe.
  185. result first key: AmdExporter.
  186. result last key: AmdExporter.
  187. ^result
  188. !
  189. recipe
  190. "Export a given package."
  191. ^{
  192. self -> #exportPackagePrologueOf:on:.
  193. self -> #exportPackageDefinitionOf:on:.
  194. self -> #exportPackageTransportOf:on:.
  195. {
  196. PluggableExporter -> #ownClassesOfPackage:.
  197. self -> #exportDefinitionOf:on:.
  198. {
  199. self -> #ownMethodsOfClass:.
  200. self -> #exportMethod:on: }.
  201. self -> #exportMetaDefinitionOf:on:.
  202. {
  203. self -> #ownMethodsOfMetaClass:.
  204. self -> #exportMethod:on: } }.
  205. {
  206. self -> #extensionMethodsOfPackage:.
  207. self -> #exportMethod:on: }.
  208. self -> #exportPackageEpilogueOf:on:
  209. }
  210. ! !
  211. !Exporter methodsFor: 'output'!
  212. exportDefinitionOf: aClass on: aStream
  213. aStream
  214. lf;
  215. nextPutAll: 'smalltalk.addClass(';
  216. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  217. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  218. nextPutAll: ', ['.
  219. aClass instanceVariableNames
  220. do: [:each | aStream nextPutAll: '''', each, '''']
  221. separatedBy: [aStream nextPutAll: ', '].
  222. aStream
  223. nextPutAll: '], ''';
  224. nextPutAll: aClass category, '''';
  225. nextPutAll: ');'.
  226. aClass comment notEmpty ifTrue: [
  227. aStream
  228. lf;
  229. nextPutAll: 'smalltalk.';
  230. nextPutAll: (self classNameFor: aClass);
  231. nextPutAll: '.comment=';
  232. nextPutAll: aClass comment asJavascript;
  233. nextPutAll: ';'].
  234. aStream lf
  235. !
  236. exportMetaDefinitionOf: aClass on: aStream
  237. aStream lf.
  238. aClass class instanceVariableNames isEmpty ifFalse: [
  239. aStream
  240. nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
  241. nextPutAll: '.iVarNames = ['.
  242. aClass class instanceVariableNames
  243. do: [:each | aStream nextPutAll: '''', each, '''']
  244. separatedBy: [aStream nextPutAll: ','].
  245. aStream nextPutAll: '];', String lf]
  246. !
  247. exportMethod: aMethod on: aStream
  248. aStream
  249. nextPutAll: 'smalltalk.addMethod(';lf;
  250. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  251. nextPutAll: 'smalltalk.method({';lf;
  252. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  253. nextPutAll: 'category: ''', aMethod category, ''',';lf;
  254. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  255. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  256. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  257. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  258. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
  259. aStream
  260. lf;
  261. nextPutAll: '}),';lf;
  262. nextPutAll: 'smalltalk.', (self classNameFor: aMethod methodClass);
  263. nextPutAll: ');';lf;lf
  264. !
  265. exportPackageDefinitionOf: aPackage on: aStream
  266. aStream
  267. nextPutAll: 'smalltalk.addPackage(';
  268. nextPutAll: '''', aPackage name, ''');';
  269. lf
  270. !
  271. exportPackageEpilogueOf: aPackage on: aStream
  272. aStream
  273. nextPutAll: '})(global_smalltalk,global_nil,global__st);';
  274. lf
  275. !
  276. exportPackagePrologueOf: aPackage on: aStream
  277. aStream
  278. nextPutAll: '(function(smalltalk,nil,_st){';
  279. lf
  280. !
  281. exportPackageTransportOf: aPackage on: aStream
  282. | json |
  283. json := aPackage transportJson.
  284. json = 'null' ifFalse: [
  285. aStream
  286. nextPutAll: 'smalltalk.packages[';
  287. nextPutAll: aPackage name asJavascript;
  288. nextPutAll: '].transport = ';
  289. nextPutAll: json;
  290. nextPutAll: ';';
  291. lf ]
  292. ! !
  293. Exporter subclass: #StrippedExporter
  294. instanceVariableNames: ''
  295. package: 'Importer-Exporter'!
  296. !StrippedExporter commentStamp!
  297. I export Amber code into a JavaScript string, but without any optional associated data like the Amber source code.!
  298. !StrippedExporter methodsFor: 'output'!
  299. exportDefinitionOf: aClass on: aStream
  300. aStream
  301. lf;
  302. nextPutAll: 'smalltalk.addClass(';
  303. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  304. nextPutAll: 'smalltalk.', (self classNameFor: aClass superclass);
  305. nextPutAll: ', ['.
  306. aClass instanceVariableNames
  307. do: [:each | aStream nextPutAll: '''', each, '''']
  308. separatedBy: [aStream nextPutAll: ', '].
  309. aStream
  310. nextPutAll: '], ''';
  311. nextPutAll: aClass category, '''';
  312. nextPutAll: ');'.
  313. aStream lf
  314. !
  315. exportMethod: aMethod on: aStream
  316. aStream
  317. nextPutAll: 'smalltalk.addMethod(';lf;
  318. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  319. nextPutAll: 'smalltalk.method({';lf;
  320. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  321. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  322. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript;
  323. nextPutAll: '}),';lf;
  324. nextPutAll: 'smalltalk.', (self classNameFor: aMethod methodClass);
  325. nextPutAll: ');';lf;lf
  326. ! !
  327. Object subclass: #AmdExporter
  328. instanceVariableNames: ''
  329. package: 'Importer-Exporter'!
  330. !AmdExporter class methodsFor: 'exporting-output'!
  331. exportPackageEpilogueOf: aPackage on: aStream
  332. aStream
  333. nextPutAll: '});';
  334. lf
  335. !
  336. exportPackagePrologueOf: aPackage on: aStream
  337. aStream
  338. nextPutAll: 'define("';
  339. nextPutAll: (aPackage amdNamespace ifNil: [ 'amber' ]); "ifNil: only for LegacyPH, it should not happen with AmdPH"
  340. nextPutAll: '/';
  341. nextPutAll: aPackage name;
  342. nextPutAll: '", ';
  343. nextPutAll: (#('amber_vm/smalltalk' 'amber_vm/nil' 'amber_vm/_st'), (self amdNamesOfPackages: aPackage loadDependencies)) asJavascript;
  344. nextPutAll: ', function(smalltalk,nil,_st){';
  345. lf
  346. ! !
  347. !AmdExporter class methodsFor: 'private'!
  348. amdNamesOfPackages: anArray
  349. | deps depNames |
  350. ^(anArray
  351. select: [ :each | each amdNamespace notNil ])
  352. collect: [ :each | each amdNamespace, '/', each name ]
  353. ! !
  354. Object subclass: #ChunkParser
  355. instanceVariableNames: 'stream'
  356. package: 'Importer-Exporter'!
  357. !ChunkParser commentStamp!
  358. I am responsible for parsing aStream contents in the chunk format.
  359. ## API
  360. ChunkParser new
  361. stream: aStream;
  362. nextChunk!
  363. !ChunkParser methodsFor: 'accessing'!
  364. stream: aStream
  365. stream := aStream
  366. ! !
  367. !ChunkParser methodsFor: 'reading'!
  368. nextChunk
  369. "The chunk format (Smalltalk Interchange Format or Fileout format)
  370. is a trivial format but can be a bit tricky to understand:
  371. - Uses the exclamation mark as delimiter of chunks.
  372. - Inside a chunk a normal exclamation mark must be doubled.
  373. - A non empty chunk must be a valid Smalltalk expression.
  374. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  375. - The object created by the expression then takes over reading chunks.
  376. This metod returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  377. | char result chunk |
  378. result := '' writeStream.
  379. [char := stream next.
  380. char notNil] whileTrue: [
  381. char = '!!' ifTrue: [
  382. stream peek = '!!'
  383. ifTrue: [stream next "skipping the escape double"]
  384. ifFalse: [^result contents trimBoth "chunk end marker found"]].
  385. result nextPut: char].
  386. ^nil "a chunk needs to end with !!"
  387. ! !
  388. !ChunkParser class methodsFor: 'instance creation'!
  389. on: aStream
  390. ^self new stream: aStream
  391. ! !
  392. Object subclass: #ExportRecipeInterpreter
  393. instanceVariableNames: ''
  394. package: 'Importer-Exporter'!
  395. !ExportRecipeInterpreter commentStamp!
  396. I am an interpreter for export recipes.
  397. ## Recipe format
  398. Recipe is an array, which can contain two kinds of elements:
  399. - an assocation where the key is the receiver and the value is a two-arguments selector
  400. In this case, `receiver perform: selector withArguments: { data. stream }` is called.
  401. This essentially defines one step of export process.
  402. The key (eg. receiver) is presumed to be some kind of 'repository' of the exporting methods
  403. that just format appropriate aspect of data into a stream; like a class or a singleton,
  404. so that the recipe itself can be decoupled from data.
  405. - a subarray, where first element is special and the rest is recursive recipe.
  406. `subarray first` must be an association similar to one above,
  407. with key being the 'repository' receiver, but value is one-arg selector.
  408. In this case, `receiver perform: selector withArguments: { data }` should create a collection.
  409. Then, the sub-recipe (`subarray allButFirst`) is applied to every element of a collection, eg.
  410. collection do: [ :each | self export: each using: sa allButFirst on: stream ]!
  411. !ExportRecipeInterpreter methodsFor: 'interpreting'!
  412. interpret: aRecipe for: anObject on: aStream
  413. | recipeStream |
  414. recipeStream := aRecipe readStream.
  415. [ recipeStream atEnd ] whileFalse: [
  416. self
  417. interpretStep: recipeStream next
  418. for: anObject
  419. on: aStream ]
  420. !
  421. interpretStep: aRecipeStep for: anObject on: aStream
  422. aRecipeStep value == aRecipeStep ifTrue: [
  423. ^ self interpretSubRecipe: aRecipeStep for: anObject on: aStream ].
  424. aRecipeStep key perform: aRecipeStep value withArguments: { anObject. aStream }
  425. !
  426. interpretSubRecipe: aRecipe for: anObject on: aStream
  427. | selection |
  428. selection := aRecipe first key
  429. perform: aRecipe first value
  430. withArguments: { anObject }.
  431. selection do: [ :each |
  432. self interpret: aRecipe allButFirst for: each on: aStream ]
  433. ! !
  434. Object subclass: #Importer
  435. instanceVariableNames: ''
  436. package: 'Importer-Exporter'!
  437. !Importer commentStamp!
  438. I can import Amber code from a string in the chunk format.
  439. ## API
  440. Importer new import: aString!
  441. !Importer methodsFor: 'fileIn'!
  442. import: aStream
  443. | chunk result parser lastEmpty |
  444. parser := ChunkParser on: aStream.
  445. lastEmpty := false.
  446. [chunk := parser nextChunk.
  447. chunk isNil] whileFalse: [
  448. chunk isEmpty
  449. ifTrue: [lastEmpty := true]
  450. ifFalse: [
  451. result := Compiler new evaluateExpression: chunk.
  452. lastEmpty
  453. ifTrue: [
  454. lastEmpty := false.
  455. result scanFrom: parser]]]
  456. ! !
  457. Object subclass: #MethodCategory
  458. instanceVariableNames: 'methods name theClass'
  459. package: 'Importer-Exporter'!
  460. !MethodCategory commentStamp!
  461. I am an abstraction for a method category in a class / metaclass.
  462. I know of my class, name and methods.
  463. I am used when exporting a package.!
  464. !MethodCategory methodsFor: 'accessing'!
  465. methods
  466. ^methods
  467. !
  468. methods: aCollection
  469. methods := aCollection
  470. !
  471. name
  472. ^name
  473. !
  474. name: aString
  475. name := aString
  476. !
  477. theClass
  478. ^theClass
  479. !
  480. theClass: aClass
  481. theClass := aClass
  482. ! !
  483. !MethodCategory class methodsFor: 'not yet classified'!
  484. name: aString theClass: aClass methods: anArray
  485. ^self new
  486. name: aString;
  487. theClass: aClass;
  488. methods: anArray;
  489. yourself
  490. ! !
  491. InterfacingObject subclass: #PackageHandler
  492. instanceVariableNames: ''
  493. package: 'Importer-Exporter'!
  494. !PackageHandler commentStamp!
  495. I am responsible for handling package loading and committing.
  496. I should not be used directly. Instead, use the corresponding `Package` methods.!
  497. !PackageHandler methodsFor: 'committing'!
  498. commit: aPackage
  499. self commitChannels
  500. do: [ :commitStrategyFactory || fileContents commitStrategy |
  501. commitStrategy := commitStrategyFactory value: aPackage.
  502. fileContents := String streamContents: [ :stream |
  503. (PluggableExporter forRecipe: commitStrategy key) exportPackage: aPackage on: stream ].
  504. self ajaxPutAt: commitStrategy value data: fileContents ]
  505. displayingProgress: 'Committing package ', aPackage name
  506. !
  507. commitChannels
  508. self subclassResponsibility
  509. ! !
  510. !PackageHandler methodsFor: 'private'!
  511. ajaxPutAt: aURL data: aString
  512. self
  513. ajax: #{
  514. 'url' -> aURL.
  515. 'type' -> 'PUT'.
  516. 'data' -> aString.
  517. 'contentType' -> 'text/plain;charset=UTF-8'.
  518. 'error' -> [ :xhr | self error: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"'] }
  519. ! !
  520. PackageHandler class instanceVariableNames: 'registry'!
  521. !PackageHandler class methodsFor: 'accessing'!
  522. classRegisteredFor: aString
  523. ^registry at: aString
  524. !
  525. for: aString
  526. ^(self classRegisteredFor: aString) new
  527. ! !
  528. !PackageHandler class methodsFor: 'initialization'!
  529. initialize
  530. super initialize.
  531. registry := #{}
  532. ! !
  533. !PackageHandler class methodsFor: 'registry'!
  534. register: aClass for: aString
  535. registry at: aString put: aClass
  536. !
  537. registerFor: aString
  538. PackageHandler register: self for: aString
  539. ! !
  540. PackageHandler subclass: #AmdPackageHandler
  541. instanceVariableNames: ''
  542. package: 'Importer-Exporter'!
  543. !AmdPackageHandler commentStamp!
  544. I am responsible for handling package loading and committing.
  545. I should not be used directly. Instead, use the corresponding `Package` methods.!
  546. !AmdPackageHandler methodsFor: 'committing'!
  547. commitChannels
  548. ^{
  549. [ :pkg | Exporter default amdRecipe -> (pkg commitPathJs, '/', pkg name, '.js') ].
  550. [ :pkg | StrippedExporter default amdRecipe -> (pkg commitPathJs, '/', pkg name, '.deploy.js') ].
  551. [ :pkg | ChunkExporter default recipe -> (pkg commitPathSt, '/', pkg name, '.st') ]
  552. }
  553. !
  554. commitPathJsFor: aPackage
  555. ^self toUrl: (self namespaceFor: aPackage)
  556. !
  557. commitPathStFor: aPackage
  558. "if _source is not mapped, .st commit will likely fail"
  559. ^self toUrl: (self namespaceFor: aPackage), '/_source'.
  560. !
  561. namespaceFor: aPackage
  562. ^aPackage amdNamespace
  563. ifNil: [ aPackage amdNamespace: self class defaultNamespace; amdNamespace ]
  564. ! !
  565. !AmdPackageHandler methodsFor: 'private'!
  566. toUrl: aString
  567. (Smalltalk current at: '_amd_require')
  568. ifNil: [ self error: 'AMD loader not present' ]
  569. ifNotNil: [ :require | ^(require basicAt: 'toUrl') value: aString ]
  570. ! !
  571. AmdPackageHandler class instanceVariableNames: 'defaultNamespace'!
  572. !AmdPackageHandler class methodsFor: 'commit paths'!
  573. commitPathsFromLoader
  574. (Smalltalk current at: '_amd_defaultNamespace')
  575. ifNotNil: [ :namespace | self defaultNamespace: namespace ]
  576. !
  577. defaultNamespace
  578. ^ defaultNamespace ifNil: [ self error: 'AMD default namespace not set.' ]
  579. !
  580. defaultNamespace: aString
  581. defaultNamespace := aString
  582. !
  583. resetCommitPaths
  584. defaultNamespace := nil
  585. ! !
  586. !AmdPackageHandler class methodsFor: 'initialization'!
  587. initialize
  588. super initialize.
  589. self registerFor: 'amd'.
  590. self commitPathsFromLoader
  591. ! !
  592. PackageHandler subclass: #LegacyPackageHandler
  593. instanceVariableNames: ''
  594. package: 'Importer-Exporter'!
  595. !LegacyPackageHandler commentStamp!
  596. I am responsible for handling package loading and committing.
  597. I should not be used directly. Instead, use the corresponding `Package` methods.!
  598. !LegacyPackageHandler methodsFor: 'committing'!
  599. commitChannels
  600. ^{
  601. [ :pkg | Exporter default recipe -> (pkg commitPathJs, '/', pkg name, '.js') ].
  602. [ :pkg | StrippedExporter default recipe -> (pkg commitPathJs, '/', pkg name, '.deploy.js') ].
  603. [ :pkg | ChunkExporter default recipe -> (pkg commitPathSt, '/', pkg name, '.st') ]
  604. }
  605. !
  606. commitPathJsFor: aPackage
  607. ^self class defaultCommitPathJs
  608. !
  609. commitPathStFor: aPackage
  610. ^self class defaultCommitPathSt
  611. ! !
  612. !LegacyPackageHandler methodsFor: 'loading'!
  613. loadPackage: packageName prefix: aString
  614. | url |
  615. url := '/', aString, '/js/', packageName, '.js'.
  616. self
  617. ajax: #{
  618. 'url' -> url.
  619. 'type' -> 'GET'.
  620. 'dataType' -> 'script'.
  621. 'complete' -> [ :jqXHR :textStatus |
  622. jqXHR readyState = 4
  623. ifTrue: [ self setupPackageNamed: packageName prefix: aString ] ].
  624. 'error' -> [ self alert: 'Could not load package at: ', url ]
  625. }
  626. !
  627. loadPackages: aCollection prefix: aString
  628. aCollection do: [ :each |
  629. self loadPackage: each prefix: aString ]
  630. ! !
  631. !LegacyPackageHandler methodsFor: 'private'!
  632. setupPackageNamed: packageName prefix: aString
  633. (Package named: packageName)
  634. setupClasses;
  635. commitPathJs: '/', aString, '/js';
  636. commitPathSt: '/', aString, '/st'
  637. ! !
  638. LegacyPackageHandler class instanceVariableNames: 'defaultCommitPathJs defaultCommitPathSt'!
  639. !LegacyPackageHandler class methodsFor: 'commit paths'!
  640. commitPathsFromLoader
  641. <
  642. var commitPath = typeof amber !!== 'undefined' && amber.commitPath;
  643. if (!!commitPath) return;
  644. if (commitPath.js) self._defaultCommitPathJs_(commitPath.js);
  645. if (commitPath.st) self._defaultCommitPathSt_(commitPath.st);
  646. >
  647. !
  648. defaultCommitPathJs
  649. ^ defaultCommitPathJs ifNil: [ defaultCommitPathJs := 'js']
  650. !
  651. defaultCommitPathJs: aString
  652. defaultCommitPathJs := aString
  653. !
  654. defaultCommitPathSt
  655. ^ defaultCommitPathSt ifNil: [ defaultCommitPathSt := 'st']
  656. !
  657. defaultCommitPathSt: aString
  658. defaultCommitPathSt := aString
  659. !
  660. resetCommitPaths
  661. defaultCommitPathJs := nil.
  662. defaultCommitPathSt := nil
  663. ! !
  664. !LegacyPackageHandler class methodsFor: 'initialization'!
  665. initialize
  666. super initialize.
  667. self registerFor: 'unknown'.
  668. self commitPathsFromLoader
  669. ! !
  670. !LegacyPackageHandler class methodsFor: 'loading'!
  671. loadPackages: aCollection prefix: aString
  672. ^ self new loadPackages: aCollection prefix: aString
  673. ! !
  674. Object subclass: #PluggableExporter
  675. instanceVariableNames: 'recipe'
  676. package: 'Importer-Exporter'!
  677. !PluggableExporter commentStamp!
  678. I am an engine for exporting structured data on a Stream.
  679. My instances are created using
  680. PluggableExporter forRecipe: aRecipe,
  681. where recipe is structured description of the exporting algorithm (see `ExportRecipeInterpreter`).
  682. The actual exporting is done by interpreting the recipe using a `RecipeInterpreter`.
  683. I am used to export amber packages, so I have a convenience method
  684. `exportPackage: aPackage on: aStream`
  685. which exports `aPackage` using the `recipe`
  686. (it is otherwise no special, so it may be renamed to export:on:)!
  687. !PluggableExporter methodsFor: 'accessing'!
  688. interpreter
  689. ^ ExportRecipeInterpreter new
  690. !
  691. recipe
  692. ^recipe
  693. !
  694. recipe: anArray
  695. recipe := anArray
  696. ! !
  697. !PluggableExporter methodsFor: 'fileOut'!
  698. exportAllPackages
  699. "Export all packages in the system."
  700. ^String streamContents: [:stream |
  701. Smalltalk current packages do: [:pkg |
  702. self exportPackage: pkg on: stream]]
  703. !
  704. exportPackage: aPackage on: aStream
  705. self interpreter interpret: self recipe for: aPackage on: aStream
  706. ! !
  707. !PluggableExporter class methodsFor: 'convenience'!
  708. ownClassesOfPackage: package
  709. "Export classes in dependency order.
  710. Update (issue #171): Remove duplicates for export"
  711. ^package sortedClasses asSet
  712. ! !
  713. !PluggableExporter class methodsFor: 'instance creation'!
  714. forRecipe: aRecipe
  715. ^self new recipe: aRecipe; yourself
  716. ! !
  717. !Package methodsFor: '*Importer-Exporter'!
  718. amdNamespace
  719. <return (self.transport && self.transport.amdNamespace) || nil>
  720. !
  721. amdNamespace: aString
  722. <
  723. if (!!self.transport) { self.transport = { type: 'amd' }; }
  724. if (self.transport.type !!== 'amd') { throw new Error('Package '+self._name()+' has transport type '+self.transport.type+', not "amd".'); }
  725. self.transport.amdNamespace = aString;
  726. >
  727. !
  728. commit
  729. ^ self transport commit: self
  730. !
  731. commitPathJs
  732. ^ (extension ifNil: [ extension := #{} ]) at: #commitPathJs ifAbsent: [self transport commitPathJsFor: self]
  733. !
  734. commitPathJs: aString
  735. ^ (extension ifNil: [ extension := #{} ]) at: #commitPathJs put: aString
  736. !
  737. commitPathSt
  738. ^ (extension ifNil: [ extension := #{} ]) at: #commitPathSt ifAbsent: [self transport commitPathStFor: self]
  739. !
  740. commitPathSt: aString
  741. ^ (extension ifNil: [ extension := #{} ]) at: #commitPathSt put: aString
  742. !
  743. transport
  744. ^ PackageHandler for: self transportType
  745. !
  746. transportJson
  747. <return JSON.stringify(self.transport || null);>
  748. !
  749. transportType
  750. <return (self.transport && self.transport.type) || 'unknown';>
  751. ! !