2
0

Kernel-ImportExport.st 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896
  1. Smalltalk createPackage: 'Kernel-ImportExport'!
  2. Object subclass: #AbstractExporter
  3. instanceVariableNames: ''
  4. package: 'Kernel-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 methods ].
  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 sorting (dependency resolution) does not matter here.
  23. Not sorting improves the speed by a number of magnitude."
  24. Smalltalk classes do: [ :each |
  25. {each. each class} do: [ :behavior |
  26. (behavior protocols includes: extensionName) ifTrue: [
  27. result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
  28. ^ result
  29. ! !
  30. !AbstractExporter methodsFor: 'convenience'!
  31. chunkEscape: aString
  32. "Replace all occurrences of !! with !!!! and trim at both ends."
  33. ^ (aString replace: '!!' with: '!!!!') trimBoth
  34. !
  35. classNameFor: aClass
  36. ^ aClass isMetaclass
  37. ifTrue: [ aClass instanceClass name, ' class' ]
  38. ifFalse: [
  39. aClass isNil
  40. ifTrue: [ 'nil' ]
  41. ifFalse: [ aClass name ] ]
  42. ! !
  43. !AbstractExporter methodsFor: 'output'!
  44. exportPackage: aPackage on: aStream
  45. self subclassResponsibility
  46. ! !
  47. AbstractExporter subclass: #ChunkExporter
  48. instanceVariableNames: ''
  49. package: 'Kernel-ImportExport'!
  50. !ChunkExporter commentStamp!
  51. I am an exporter dedicated to outputting Amber source code in the classic Smalltalk chunk format.
  52. I do not output any compiled code.!
  53. !ChunkExporter methodsFor: 'accessing'!
  54. extensionCategoriesOfPackage: aPackage
  55. "Issue #143: sort protocol alphabetically"
  56. | name map result |
  57. name := aPackage name.
  58. result := OrderedCollection new.
  59. (Package sortedClasses: Smalltalk classes) do: [ :each |
  60. {each. each class} do: [ :aClass |
  61. map := Dictionary new.
  62. aClass protocolsDo: [ :category :methods |
  63. category = ('*', name) ifTrue: [ map at: category put: methods ] ].
  64. result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |
  65. MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].
  66. ^ result
  67. !
  68. ownCategoriesOfClass: aClass
  69. "Answer the protocols of aClass that are not package extensions"
  70. "Issue #143: sort protocol alphabetically"
  71. | map |
  72. map := Dictionary new.
  73. aClass protocolsDo: [ :each :methods |
  74. (each match: '^\*') ifFalse: [ map at: each put: methods ] ].
  75. ^ (map keys sorted: [ :a :b | a <= b ]) collect: [ :each |
  76. MethodCategory name: each theClass: aClass methods: (map at: each) ]
  77. !
  78. ownCategoriesOfMetaClass: aClass
  79. "Issue #143: sort protocol alphabetically"
  80. ^ self ownCategoriesOfClass: aClass class
  81. !
  82. ownMethodProtocolsOfClass: aClass
  83. "Answer a collection of ExportMethodProtocol object of aClass that are not package extensions"
  84. ^ aClass ownProtocols collect: [ :each |
  85. ExportMethodProtocol name: each theClass: aClass ]
  86. ! !
  87. !ChunkExporter methodsFor: 'output'!
  88. exportCategoryEpilogueOf: aCategory on: aStream
  89. aStream nextPutAll: ' !!'; lf; lf
  90. !
  91. exportCategoryPrologueOf: aCategory on: aStream
  92. aStream
  93. nextPutAll: '!!', (self classNameFor: aCategory theClass);
  94. nextPutAll: ' methodsFor: ''', aCategory name, '''!!'
  95. !
  96. exportDefinitionOf: aClass on: aStream
  97. "Chunk format."
  98. aStream
  99. nextPutAll: (self classNameFor: aClass superclass);
  100. nextPutAll: ' subclass: #', (self classNameFor: aClass); lf;
  101. tab; nextPutAll: 'instanceVariableNames: '''.
  102. aClass instanceVariableNames
  103. do: [ :each | aStream nextPutAll: each ]
  104. separatedBy: [ aStream nextPutAll: ' ' ].
  105. aStream
  106. nextPutAll: ''''; lf;
  107. tab; nextPutAll: 'package: ''', aClass category, '''!!'; lf.
  108. aClass comment notEmpty ifTrue: [
  109. aStream
  110. nextPutAll: '!!', (self classNameFor: aClass), ' commentStamp!!';lf;
  111. nextPutAll: (self chunkEscape: aClass comment), '!!';lf ].
  112. aStream lf
  113. !
  114. exportMetaDefinitionOf: aClass on: aStream
  115. aClass class instanceVariableNames isEmpty ifFalse: [
  116. aStream
  117. nextPutAll: (self classNameFor: aClass class);
  118. nextPutAll: ' instanceVariableNames: '''.
  119. aClass class instanceVariableNames
  120. do: [ :each | aStream nextPutAll: each ]
  121. separatedBy: [ aStream nextPutAll: ' ' ].
  122. aStream
  123. nextPutAll: '''!!'; lf; lf ]
  124. !
  125. exportMethod: aMethod on: aStream
  126. aStream
  127. lf; lf; nextPutAll: (self chunkEscape: aMethod source); lf;
  128. nextPutAll: '!!'
  129. !
  130. exportPackage: aPackage on: aStream
  131. self exportPackageDefinitionOf: aPackage on: aStream.
  132. aPackage sortedClasses do: [ :each |
  133. self exportDefinitionOf: each on: aStream.
  134. self
  135. exportProtocols: (self ownMethodProtocolsOfClass: each)
  136. on: aStream.
  137. self exportMetaDefinitionOf: each on: aStream.
  138. self
  139. exportProtocols: (self ownMethodProtocolsOfClass: each class)
  140. on: aStream ].
  141. self
  142. exportProtocols: (self extensionProtocolsOfPackage: aPackage)
  143. on: aStream
  144. !
  145. exportPackageDefinitionOf: aPackage on: aStream
  146. aStream
  147. nextPutAll: 'Smalltalk createPackage: ''', aPackage name, '''!!';
  148. lf
  149. !
  150. exportProtocol: aProtocol on: aStream
  151. self exportProtocolPrologueOf: aProtocol on: aStream.
  152. aProtocol methods do: [ :method |
  153. self exportMethod: method on: aStream ].
  154. self exportProtocolEpilogueOf: aProtocol on: aStream
  155. !
  156. exportProtocolEpilogueOf: aProtocol on: aStream
  157. aStream nextPutAll: ' !!'; lf; lf
  158. !
  159. exportProtocolPrologueOf: aProtocol on: aStream
  160. aStream
  161. nextPutAll: '!!', (self classNameFor: aProtocol theClass);
  162. nextPutAll: ' methodsFor: ''', aProtocol name, '''!!'
  163. !
  164. exportProtocols: aCollection on: aStream
  165. aCollection do: [ :each |
  166. self exportProtocol: each on: aStream ]
  167. ! !
  168. AbstractExporter subclass: #Exporter
  169. instanceVariableNames: ''
  170. package: 'Kernel-ImportExport'!
  171. !Exporter commentStamp!
  172. I am responsible for outputting Amber code into a JavaScript string.
  173. The generated output is enough to reconstruct the exported data, including Smalltalk source code and other metadata.
  174. ## Use case
  175. I am typically used to save code outside of the Amber runtime (committing to disk, etc.).!
  176. !Exporter methodsFor: 'accessing'!
  177. ownMethodsOfClass: aClass
  178. "Issue #143: sort methods alphabetically"
  179. ^ ((aClass methodDictionary values) sorted: [ :a :b | a selector <= b selector ])
  180. reject: [ :each | (each protocol match: '^\*') ]
  181. !
  182. ownMethodsOfMetaClass: aClass
  183. "Issue #143: sort methods alphabetically"
  184. ^ self ownMethodsOfClass: aClass class
  185. ! !
  186. !Exporter methodsFor: 'convenience'!
  187. classNameFor: aClass
  188. ^ aClass isMetaclass
  189. ifTrue: [ aClass instanceClass name, '.klass' ]
  190. ifFalse: [
  191. aClass isNil
  192. ifTrue: [ 'nil' ]
  193. ifFalse: [ aClass name ] ]
  194. ! !
  195. !Exporter methodsFor: 'output'!
  196. exportDefinitionOf: aClass on: aStream
  197. aStream
  198. lf;
  199. nextPutAll: 'smalltalk.addClass(';
  200. nextPutAll: '''', (self classNameFor: aClass), ''', ';
  201. nextPutAll: 'globals.', (self classNameFor: aClass superclass);
  202. nextPutAll: ', ['.
  203. aClass instanceVariableNames
  204. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  205. separatedBy: [ aStream nextPutAll: ', ' ].
  206. aStream
  207. nextPutAll: '], ''';
  208. nextPutAll: aClass category, '''';
  209. nextPutAll: ');'.
  210. aClass comment notEmpty ifTrue: [
  211. aStream
  212. lf;
  213. nextPutAll: 'globals.';
  214. nextPutAll: (self classNameFor: aClass);
  215. nextPutAll: '.comment=';
  216. nextPutAll: aClass comment asJavascript;
  217. nextPutAll: ';' ].
  218. aStream lf
  219. !
  220. exportMetaDefinitionOf: aClass on: aStream
  221. aStream lf.
  222. aClass class instanceVariableNames isEmpty ifFalse: [
  223. aStream
  224. nextPutAll: 'globals.', (self classNameFor: aClass class);
  225. nextPutAll: '.iVarNames = ['.
  226. aClass class instanceVariableNames
  227. do: [ :each | aStream nextPutAll: '''', each, '''' ]
  228. separatedBy: [ aStream nextPutAll: ',' ].
  229. aStream nextPutAll: '];', String lf ]
  230. !
  231. exportMethod: aMethod on: aStream
  232. aStream
  233. nextPutAll: 'smalltalk.addMethod(';lf;
  234. "nextPutAll: aMethod selector asSelector asJavascript, ',';lf;"
  235. nextPutAll: 'smalltalk.method({';lf;
  236. nextPutAll: 'selector: ', aMethod selector asJavascript, ',';lf;
  237. nextPutAll: 'protocol: ''', aMethod protocol, ''',';lf;
  238. nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
  239. nextPutAll: 'args: ', aMethod arguments asJavascript, ','; lf;
  240. nextPutAll: 'source: ', aMethod source asJavascript, ',';lf;
  241. nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
  242. nextPutAll: 'referencedClasses: ', aMethod referencedClasses asJavascript.
  243. aStream
  244. lf;
  245. nextPutAll: '}),';lf;
  246. nextPutAll: 'globals.', (self classNameFor: aMethod methodClass);
  247. nextPutAll: ');';lf;lf
  248. !
  249. exportPackage: aPackage on: aStream
  250. self
  251. exportPackagePrologueOf: aPackage on: aStream;
  252. exportPackageDefinitionOf: aPackage on: aStream;
  253. exportPackageTransportOf: aPackage on: aStream.
  254. aPackage sortedClasses do: [ :each |
  255. self exportDefinitionOf: each on: aStream.
  256. each ownMethods do: [ :method |
  257. self exportMethod: method on: aStream ].
  258. self exportMetaDefinitionOf: each on: aStream.
  259. each class ownMethods do: [ :method |
  260. self exportMethod: method on: aStream ] ].
  261. (self extensionMethodsOfPackage: aPackage) do: [ :each |
  262. self exportMethod: each on: aStream ].
  263. self exportPackageEpilogueOf: aPackage on: aStream
  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. aStream
  283. nextPutAll: 'smalltalk.packages[';
  284. nextPutAll: aPackage name asJavascript;
  285. nextPutAll: '].transport = ';
  286. nextPutAll: aPackage transport asJSONString;
  287. nextPutAll: ';';
  288. lf
  289. ! !
  290. Exporter subclass: #AmdExporter
  291. instanceVariableNames: 'namespace'
  292. package: 'Kernel-ImportExport'!
  293. !AmdExporter commentStamp!
  294. I am used to export Packages in an AMD (Asynchronous Module Definition) JavaScript format.!
  295. !AmdExporter methodsFor: 'output'!
  296. exportPackageEpilogueOf: aPackage on: aStream
  297. aStream
  298. nextPutAll: '});';
  299. lf
  300. !
  301. exportPackagePrologueOf: aPackage on: aStream
  302. aStream
  303. nextPutAll: 'define("';
  304. nextPutAll: (self amdNamespaceOfPackage: aPackage);
  305. nextPutAll: '/';
  306. nextPutAll: aPackage name;
  307. nextPutAll: '", ';
  308. nextPutAll: (#('amber_vm/smalltalk' 'amber_vm/nil' 'amber_vm/_st' 'amber_vm/globals'), (self amdNamesOfPackages: aPackage loadDependencies)) asJavascript;
  309. nextPutAll: ', function(smalltalk,nil,_st, globals){';
  310. lf
  311. ! !
  312. !AmdExporter methodsFor: 'private'!
  313. amdNamesOfPackages: anArray
  314. ^ (anArray
  315. select: [ :each | (self amdNamespaceOfPackage: each) notNil ])
  316. collect: [ :each | (self amdNamespaceOfPackage: each), '/', each name ]
  317. !
  318. amdNamespaceOfPackage: aPackage
  319. ^ (aPackage transport type = 'amd')
  320. ifTrue: [ aPackage transport namespace ]
  321. ifFalse: [ nil ]
  322. ! !
  323. Object subclass: #ChunkParser
  324. instanceVariableNames: 'stream last'
  325. package: 'Kernel-ImportExport'!
  326. !ChunkParser commentStamp!
  327. I am responsible for parsing aStream contents in the chunk format.
  328. ## API
  329. ChunkParser new
  330. stream: aStream;
  331. nextChunk!
  332. !ChunkParser methodsFor: 'accessing'!
  333. last
  334. ^ last
  335. !
  336. stream: aStream
  337. stream := aStream
  338. ! !
  339. !ChunkParser methodsFor: 'reading'!
  340. nextChunk
  341. "The chunk format (Smalltalk Interchange Format or Fileout format)
  342. is a trivial format but can be a bit tricky to understand:
  343. - Uses the exclamation mark as delimiter of chunks.
  344. - Inside a chunk a normal exclamation mark must be doubled.
  345. - A non empty chunk must be a valid Smalltalk expression.
  346. - A chunk on top level with a preceding empty chunk is an instruction chunk:
  347. - The object created by the expression then takes over reading chunks.
  348. This method returns next chunk as a String (trimmed), empty String (all whitespace) or nil."
  349. | char result chunk |
  350. result := '' writeStream.
  351. [ char := stream next.
  352. char notNil ] whileTrue: [
  353. char = '!!' ifTrue: [
  354. stream peek = '!!'
  355. ifTrue: [ stream next "skipping the escape double" ]
  356. ifFalse: [ ^ last := result contents trimBoth "chunk end marker found" ]].
  357. result nextPut: char ].
  358. ^ last := nil "a chunk needs to end with !!"
  359. ! !
  360. !ChunkParser class methodsFor: 'instance creation'!
  361. on: aStream
  362. ^ self new stream: aStream
  363. ! !
  364. Object subclass: #ExportMethodProtocol
  365. instanceVariableNames: 'name theClass'
  366. package: 'Kernel-ImportExport'!
  367. !ExportMethodProtocol commentStamp!
  368. I am an abstraction for a method protocol in a class / metaclass.
  369. I know of my class, name and methods.
  370. I am used when exporting a package.!
  371. !ExportMethodProtocol methodsFor: 'accessing'!
  372. methods
  373. ^ (self theClass methodsInProtocol: self name)
  374. sorted: [ :a :b | a selector <= b selector ]
  375. !
  376. name
  377. ^ name
  378. !
  379. name: aString
  380. name := aString
  381. !
  382. theClass
  383. ^ theClass
  384. !
  385. theClass: aClass
  386. theClass := aClass
  387. ! !
  388. !ExportMethodProtocol class methodsFor: 'instance creation'!
  389. name: aString theClass: aClass
  390. ^ self new
  391. name: aString;
  392. theClass: aClass;
  393. yourself
  394. ! !
  395. Object subclass: #Importer
  396. instanceVariableNames: 'lastSection lastChunk'
  397. package: 'Kernel-ImportExport'!
  398. !Importer commentStamp!
  399. I can import Amber code from a string in the chunk format.
  400. ## API
  401. Importer new import: aString!
  402. !Importer methodsFor: 'accessing'!
  403. lastChunk
  404. ^ lastChunk
  405. !
  406. lastSection
  407. ^ lastSection
  408. ! !
  409. !Importer methodsFor: 'fileIn'!
  410. import: aStream
  411. | chunk result parser lastEmpty |
  412. parser := ChunkParser on: aStream.
  413. lastEmpty := false.
  414. lastSection := 'n/a, not started'.
  415. lastChunk := nil.
  416. [
  417. [ chunk := parser nextChunk.
  418. chunk isNil ] whileFalse: [
  419. chunk isEmpty
  420. ifTrue: [ lastEmpty := true ]
  421. ifFalse: [
  422. lastSection := chunk.
  423. result := Compiler new evaluateExpression: chunk.
  424. lastEmpty
  425. ifTrue: [
  426. lastEmpty := false.
  427. result scanFrom: parser ]] ].
  428. lastSection := 'n/a, finished'
  429. ] on: Error do: [:e | lastChunk := parser last. e signal ].
  430. ! !
  431. InterfacingObject subclass: #PackageHandler
  432. instanceVariableNames: ''
  433. package: 'Kernel-ImportExport'!
  434. !PackageHandler commentStamp!
  435. I am responsible for handling package loading and committing.
  436. I should not be used directly. Instead, use the corresponding `Package` methods.!
  437. !PackageHandler methodsFor: 'accessing'!
  438. chunkContentsFor: aPackage
  439. ^ String streamContents: [ :str |
  440. self chunkExporter exportPackage: aPackage on: str ]
  441. !
  442. chunkExporterClass
  443. ^ ChunkExporter
  444. !
  445. commitPathJsFor: aPackage
  446. self subclassResponsibility
  447. !
  448. commitPathStFor: aPackage
  449. self subclassResponsibility
  450. !
  451. contentsFor: aPackage
  452. ^ String streamContents: [ :str |
  453. self exporter exportPackage: aPackage on: str ]
  454. !
  455. exporterClass
  456. ^ Exporter
  457. ! !
  458. !PackageHandler methodsFor: 'committing'!
  459. commit: aPackage
  460. {
  461. [ self commitStFileFor: aPackage ].
  462. [ self commitJsFileFor: aPackage ]
  463. }
  464. do: [ :each | each value ]
  465. displayingProgress: 'Committing package ', aPackage name
  466. !
  467. commitJsFileFor: aPackage
  468. self
  469. ajaxPutAt: (self commitPathJsFor: aPackage), '/', aPackage name, '.js'
  470. data: (self contentsFor: aPackage)
  471. !
  472. commitStFileFor: aPackage
  473. self
  474. ajaxPutAt: (self commitPathStFor: aPackage), '/', aPackage name, '.st'
  475. data: (self chunkContentsFor: aPackage)
  476. ! !
  477. !PackageHandler methodsFor: 'factory'!
  478. chunkExporter
  479. ^ self chunkExporterClass new
  480. !
  481. exporter
  482. ^ self exporterClass new
  483. ! !
  484. !PackageHandler methodsFor: 'loading'!
  485. load: aPackage
  486. self subclassResponsibility
  487. ! !
  488. !PackageHandler methodsFor: 'private'!
  489. ajaxPutAt: aURL data: aString
  490. self
  491. ajax: #{
  492. 'url' -> aURL.
  493. 'type' -> 'PUT'.
  494. 'data' -> aString.
  495. 'contentType' -> 'text/plain;charset=UTF-8'.
  496. 'error' -> [ :xhr | self alert: 'Commiting ' , aURL , ' failed with reason: "' , (xhr responseText) , '"' ] }
  497. ! !
  498. PackageHandler subclass: #AmdPackageHandler
  499. instanceVariableNames: ''
  500. package: 'Kernel-ImportExport'!
  501. !AmdPackageHandler commentStamp!
  502. I am responsible for handling package loading and committing.
  503. I should not be used directly. Instead, use the corresponding `Package` methods.!
  504. !AmdPackageHandler methodsFor: 'accessing'!
  505. commitPathJsFor: aPackage
  506. ^ self toUrl: (self namespaceFor: aPackage)
  507. !
  508. commitPathStFor: aPackage
  509. "if _source is not mapped, .st commit will likely fail"
  510. ^ self toUrl: (self namespaceFor: aPackage), '/_source'.
  511. !
  512. exporterClass
  513. ^ AmdExporter
  514. ! !
  515. !AmdPackageHandler methodsFor: 'committing'!
  516. namespaceFor: aPackage
  517. ^ aPackage transport namespace
  518. ! !
  519. !AmdPackageHandler methodsFor: 'loading'!
  520. load: aPackage
  521. Smalltalk amdRequire
  522. ifNil: [ self error: 'AMD loader not present' ]
  523. ifNotNil: [ :require |
  524. require value: (Array new: (self namespaceFor: aPackage), '/', aPackage name ) ]
  525. ! !
  526. !AmdPackageHandler methodsFor: 'private'!
  527. toUrl: aString
  528. ^ Smalltalk amdRequire
  529. ifNil: [ self error: 'AMD loader not present' ]
  530. ifNotNil: [ :require | (require basicAt: 'toUrl') value: aString ]
  531. ! !
  532. !AmdPackageHandler class methodsFor: 'commit paths'!
  533. defaultNamespace
  534. ^ Smalltalk defaultAmdNamespace
  535. !
  536. defaultNamespace: aString
  537. Smalltalk defaultAmdNamespace: aString
  538. ! !
  539. Object subclass: #PackageTransport
  540. instanceVariableNames: 'package'
  541. package: 'Kernel-ImportExport'!
  542. !PackageTransport commentStamp!
  543. I represent the transport mechanism used to commit a package.
  544. My concrete subclasses have a `#handler` to which committing is delegated.!
  545. !PackageTransport methodsFor: 'accessing'!
  546. commitHandlerClass
  547. self subclassResponsibility
  548. !
  549. definition
  550. ^ ''
  551. !
  552. package
  553. ^ package
  554. !
  555. package: aPackage
  556. package := aPackage
  557. !
  558. type
  559. ^ self class type
  560. ! !
  561. !PackageTransport methodsFor: 'committing'!
  562. commit
  563. self commitHandler commit: self package
  564. ! !
  565. !PackageTransport methodsFor: 'converting'!
  566. asJSON
  567. ^ #{ 'type' -> self type }
  568. ! !
  569. !PackageTransport methodsFor: 'factory'!
  570. commitHandler
  571. ^ self commitHandlerClass new
  572. ! !
  573. !PackageTransport methodsFor: 'initialization'!
  574. setupFromJson: anObject
  575. "no op. override if needed in subclasses"
  576. ! !
  577. !PackageTransport methodsFor: 'loading'!
  578. load
  579. self commitHandler load: self package
  580. ! !
  581. PackageTransport class instanceVariableNames: 'registry'!
  582. !PackageTransport class methodsFor: 'accessing'!
  583. classRegisteredFor: aString
  584. ^ registry at: aString
  585. !
  586. defaultType
  587. ^ AmdPackageTransport type
  588. !
  589. type
  590. "Override in subclasses"
  591. ^ nil
  592. ! !
  593. !PackageTransport class methodsFor: 'initialization'!
  594. initialize
  595. super initialize.
  596. registry := #{}.
  597. self register
  598. ! !
  599. !PackageTransport class methodsFor: 'instance creation'!
  600. for: aString
  601. ^ (self classRegisteredFor: aString) new
  602. !
  603. fromJson: anObject
  604. anObject ifNil: [ ^ self for: self defaultType ].
  605. ^ (self for: anObject type)
  606. setupFromJson: anObject;
  607. yourself
  608. ! !
  609. !PackageTransport class methodsFor: 'registration'!
  610. register
  611. PackageTransport register: self
  612. !
  613. register: aClass
  614. aClass type ifNotNil: [
  615. registry at: aClass type put: aClass ]
  616. ! !
  617. PackageTransport subclass: #AmdPackageTransport
  618. instanceVariableNames: 'namespace'
  619. package: 'Kernel-ImportExport'!
  620. !AmdPackageTransport commentStamp!
  621. I am the default transport for committing packages.
  622. See `AmdExporter` and `AmdPackageHandler`.!
  623. !AmdPackageTransport methodsFor: 'accessing'!
  624. commitHandlerClass
  625. ^ AmdPackageHandler
  626. !
  627. definition
  628. ^ String streamContents: [ :stream |
  629. stream
  630. nextPutAll: self class name;
  631. nextPutAll: ' namespace: ';
  632. nextPutAll: '''', self namespace, '''' ]
  633. !
  634. namespace
  635. ^ namespace ifNil: [ self defaultNamespace ]
  636. !
  637. namespace: aString
  638. namespace := aString
  639. ! !
  640. !AmdPackageTransport methodsFor: 'converting'!
  641. asJSON
  642. ^ super asJSON
  643. at: 'amdNamespace' put: self namespace;
  644. yourself
  645. ! !
  646. !AmdPackageTransport methodsFor: 'defaults'!
  647. defaultNamespace
  648. ^ Smalltalk defaultAmdNamespace
  649. ! !
  650. !AmdPackageTransport methodsFor: 'initialization'!
  651. setupFromJson: anObject
  652. self namespace: (anObject at: 'amdNamespace')
  653. ! !
  654. !AmdPackageTransport methodsFor: 'printing'!
  655. printOn: aStream
  656. super printOn: aStream.
  657. aStream
  658. nextPutAll: ' (AMD Namespace: ';
  659. nextPutAll: self namespace;
  660. nextPutAll: ')'
  661. ! !
  662. !AmdPackageTransport class methodsFor: 'accessing'!
  663. type
  664. ^ 'amd'
  665. ! !
  666. !AmdPackageTransport class methodsFor: 'instance creation'!
  667. namespace: aString
  668. ^ self new
  669. namespace: aString;
  670. yourself
  671. ! !
  672. !Package methodsFor: '*Kernel-ImportExport'!
  673. commit
  674. ^ self transport commit
  675. !
  676. load
  677. ^ self transport load
  678. !
  679. loadFromNamespace: aString
  680. ^ self transport
  681. namespace: aString;
  682. load
  683. ! !
  684. !Package class methodsFor: '*Kernel-ImportExport'!
  685. load: aPackageName
  686. (self named: aPackageName) load
  687. !
  688. load: aPackageName fromNamespace: aString
  689. (self named: aPackageName) loadFromNamespace: aString
  690. ! !