IDE.st 45 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216
  1. Widget subclass: #TabManager
  2. instanceVariableNames: 'selectedTab tabs opened ul'
  3. category: 'IDE'!
  4. !TabManager methodsFor: 'accessing'!
  5. tabs
  6. ^tabs ifNil: [tabs := Array new]
  7. !
  8. labelFor: aWidget
  9. | label maxSize |
  10. maxSize := 15.
  11. label := aWidget label copyFrom: 0 to: (aWidget label size min: maxSize).
  12. aWidget label size > maxSize ifTrue: [
  13. label := label, '...'].
  14. ^label
  15. ! !
  16. !TabManager methodsFor: 'actions'!
  17. updateBodyMargin
  18. self setBodyMargin: '#jtalk' asJQuery height + 27
  19. !
  20. updatePosition
  21. <jQuery('#jtalk').css('top', '').css('bottom', '27px')>
  22. !
  23. removeBodyMargin
  24. self setBodyMargin: 0
  25. !
  26. setBodyMargin: anInteger
  27. '.jtalkBody' asJQuery cssAt: 'margin-bottom' put: anInteger asString, 'px'
  28. !
  29. onResize: aBlock
  30. <jQuery('#jtalk').resizable({
  31. handles: 'n',
  32. resize: aBlock,
  33. minHeight: 230
  34. })>
  35. !
  36. onWindowResize: aBlock
  37. <jQuery(window).resize(aBlock)>
  38. !
  39. open
  40. opened ifFalse: [
  41. 'body' asJQuery addClass: 'jtalkBody'.
  42. '#jtalk' asJQuery show.
  43. ul asJQuery show.
  44. self updateBodyMargin.
  45. selectedTab show.
  46. opened := true]
  47. !
  48. close
  49. opened ifTrue: [
  50. '#jtalk' asJQuery hide.
  51. ul asJQuery hide.
  52. selectedTab hide.
  53. self removeBodyMargin.
  54. 'body' asJQuery removeClass: 'jtalkBody'.
  55. opened := false]
  56. !
  57. newBrowserTab
  58. Browser open
  59. !
  60. selectTab: aWidget
  61. self open.
  62. selectedTab := aWidget.
  63. self tabs do: [:each |
  64. each hide].
  65. aWidget show.
  66. self update
  67. !
  68. closeTab: aWidget
  69. self removeTab: aWidget.
  70. self selectTab: self tabs last.
  71. aWidget remove.
  72. self update
  73. ! !
  74. !TabManager methodsFor: 'adding/Removing'!
  75. addTab: aWidget
  76. self tabs add: aWidget.
  77. '#jtalk' asJQuery append: aWidget.
  78. aWidget hide
  79. !
  80. removeTab: aWidget
  81. self tabs remove: aWidget.
  82. self update
  83. ! !
  84. !TabManager methodsFor: 'initialization'!
  85. initialize
  86. super initialize.
  87. opened := true.
  88. 'body' asJQuery
  89. append: self;
  90. append: [:html | html div id: 'jtalk'];
  91. addClass: 'jtalkBody'.
  92. self
  93. addTab: Transcript current;
  94. addTab: Workspace new;
  95. addTab: TestRunner new.
  96. self selectTab: self tabs last.
  97. self
  98. onResize: [self updateBodyMargin; updatePosition];
  99. onWindowResize: [self updatePosition]
  100. ! !
  101. !TabManager methodsFor: 'rendering'!
  102. renderOn: html
  103. ul := html ul
  104. id: 'jtalkTabs';
  105. yourself.
  106. self renderTabs
  107. !
  108. renderTabFor: aWidget on: html
  109. | li |
  110. li := html li.
  111. selectedTab = aWidget ifTrue: [
  112. li class: 'selected'].
  113. li with: [
  114. aWidget canBeClosed ifTrue: [
  115. html span
  116. class: 'close';
  117. with: 'x';
  118. onClick: [self closeTab: aWidget]].
  119. html span
  120. with: (self labelFor: aWidget);
  121. onClick: [self selectTab: aWidget]]
  122. !
  123. renderTabs
  124. ul contents: [:html |
  125. html li
  126. class: 'closeAll';
  127. with: 'x';
  128. onClick: [self close].
  129. self tabs do: [:each |
  130. self renderTabFor: each on: html].
  131. html li
  132. class: 'newtab';
  133. with: ' + ';
  134. onClick: [self newBrowserTab]]
  135. ! !
  136. !TabManager methodsFor: 'updating'!
  137. update
  138. self renderTabs
  139. ! !
  140. TabManager class instanceVariableNames: 'current'!
  141. !TabManager class methodsFor: 'instance creation'!
  142. current
  143. ^current ifNil: [current := super new]
  144. !
  145. new
  146. self shouldNotImplement
  147. ! !
  148. Widget subclass: #TabWidget
  149. instanceVariableNames: 'div'
  150. category: 'IDE'!
  151. !TabWidget methodsFor: 'accessing'!
  152. label
  153. self subclassResponsibility
  154. ! !
  155. !TabWidget methodsFor: 'actions'!
  156. open
  157. TabManager current addTab: self.
  158. TabManager current selectTab: self
  159. !
  160. show
  161. div asJQuery show
  162. !
  163. hide
  164. div asJQuery hide
  165. !
  166. remove
  167. div asJQuery remove
  168. !
  169. close
  170. TabManager current closeTab: self
  171. ! !
  172. !TabWidget methodsFor: 'rendering'!
  173. renderOn: html
  174. div := html div
  175. class: 'jtalkTool';
  176. yourself.
  177. self renderTab
  178. !
  179. renderBoxOn: html
  180. !
  181. renderButtonsOn: html
  182. !
  183. update
  184. self renderTab
  185. !
  186. renderTab
  187. div contents: [:html |
  188. html div
  189. class: 'jt_box';
  190. with: [self renderBoxOn: html].
  191. html div
  192. class: 'jt_buttons';
  193. with: [self renderButtonsOn: html]]
  194. ! !
  195. !TabWidget methodsFor: 'testing'!
  196. canBeClosed
  197. ^false
  198. ! !
  199. !TabWidget class methodsFor: 'instance creation'!
  200. open
  201. ^self new open
  202. ! !
  203. TabWidget subclass: #Workspace
  204. instanceVariableNames: 'sourceArea'
  205. category: 'IDE'!
  206. !Workspace methodsFor: 'accessing'!
  207. label
  208. ^'[Workspace]'
  209. ! !
  210. !Workspace methodsFor: 'actions'!
  211. clearWorkspace
  212. sourceArea clear
  213. !
  214. doIt
  215. sourceArea doIt
  216. !
  217. printIt
  218. sourceArea printIt
  219. !
  220. inspectIt
  221. sourceArea inspectIt
  222. ! !
  223. !Workspace methodsFor: 'rendering'!
  224. renderBoxOn: html
  225. sourceArea := SourceArea new.
  226. sourceArea renderOn: html
  227. !
  228. renderButtonsOn: html
  229. html button
  230. with: 'DoIt';
  231. title: 'ctrl+d';
  232. onClick: [self doIt].
  233. html button
  234. with: 'PrintIt';
  235. title: 'ctrl+p';
  236. onClick: [self printIt].
  237. html button
  238. with: 'InspectIt';
  239. title: 'ctrl+i';
  240. onClick: [self inspectIt].
  241. html button
  242. with: 'Clear workspace';
  243. onClick: [self clearWorkspace]
  244. ! !
  245. TabWidget subclass: #Transcript
  246. instanceVariableNames: 'textarea'
  247. category: 'IDE'!
  248. !Transcript methodsFor: 'accessing'!
  249. label
  250. ^'[Transcript]'
  251. ! !
  252. !Transcript methodsFor: 'actions'!
  253. show: anObject
  254. textarea asJQuery val: textarea asJQuery val, anObject asString.
  255. !
  256. cr
  257. textarea asJQuery val: textarea asJQuery val, String cr.
  258. !
  259. clear
  260. textarea asJQuery val: ''
  261. ! !
  262. !Transcript methodsFor: 'rendering'!
  263. renderBoxOn: html
  264. textarea := html textarea.
  265. textarea asJQuery call: 'tabby'.
  266. textarea
  267. class: 'jt_transcript';
  268. at: 'spellcheck' put: 'false'
  269. !
  270. renderButtonsOn: html
  271. html button
  272. with: 'Clear transcript';
  273. onClick: [self clear]
  274. ! !
  275. Transcript class instanceVariableNames: 'current'!
  276. !Transcript class methodsFor: 'instance creation'!
  277. open
  278. TabManager current
  279. open;
  280. selectTab: self current
  281. !
  282. new
  283. self shouldNotImplement
  284. !
  285. current
  286. ^current ifNil: [current := super new]
  287. ! !
  288. !Transcript class methodsFor: 'printing'!
  289. show: anObject
  290. self current show: anObject
  291. !
  292. cr
  293. self current show: String cr
  294. !
  295. clear
  296. self current clear
  297. ! !
  298. TabWidget subclass: #Browser
  299. instanceVariableNames: 'selectedCategory selectedClass selectedProtocol selectedMethod commitButton categoriesList classesList protocolsList methodsList sourceArea tabsList selectedTab saveButton classButtons methodButtons unsavedChanges input'
  300. category: 'IDE'!
  301. !Browser methodsFor: 'accessing'!
  302. label
  303. ^selectedClass
  304. ifNil: ['Browser (nil)']
  305. ifNotNil: [selectedClass name]
  306. !
  307. categories
  308. | categories |
  309. categories := Array new.
  310. Smalltalk current classes do: [:each |
  311. (categories includes: each category) ifFalse: [
  312. categories add: each category]].
  313. ^categories sort
  314. !
  315. classes
  316. ^(Smalltalk current classes
  317. select: [:each | each category = selectedCategory])
  318. sort: [:a :b | a name < b name]
  319. !
  320. protocols
  321. | klass |
  322. selectedClass ifNotNil: [
  323. selectedTab = #comment ifTrue: [^#()].
  324. klass := selectedTab = #instance
  325. ifTrue: [selectedClass]
  326. ifFalse: [selectedClass class].
  327. klass methodDictionary isEmpty ifTrue: [
  328. ^Array with: 'not yet classified'].
  329. ^klass protocols].
  330. ^Array new
  331. !
  332. methods
  333. | klass |
  334. selectedTab = #comment ifTrue: [^#()].
  335. selectedClass ifNotNil: [
  336. klass := selectedTab = #instance
  337. ifTrue: [selectedClass]
  338. ifFalse: [selectedClass class]].
  339. ^(selectedProtocol
  340. ifNil: [
  341. klass
  342. ifNil: [#()]
  343. ifNotNil: [klass methodDictionary values]]
  344. ifNotNil: [
  345. klass methodDictionary values select: [:each |
  346. each category = selectedProtocol]]) sort: [:a :b | a selector < b selector]
  347. !
  348. source
  349. selectedTab = #comment ifFalse: [
  350. ^(selectedProtocol notNil or: [selectedMethod notNil])
  351. ifFalse: [self declarationSource]
  352. ifTrue: [self methodSource]].
  353. ^selectedClass
  354. ifNil: ['']
  355. ifNotNil: [self classCommentSource]
  356. !
  357. methodSource
  358. ^selectedMethod
  359. ifNil: [self dummyMethodSource]
  360. ifNotNil: [selectedMethod source]
  361. !
  362. dummyMethodSource
  363. ^'messageSelectorAndArgumentNames
  364. "comment stating purpose of message"
  365. | temporary variable names |
  366. statements'
  367. !
  368. declarationSource
  369. ^selectedTab = #instance
  370. ifTrue: [self classDeclarationSource]
  371. ifFalse: [self metaclassDeclarationSource]
  372. !
  373. classDeclarationSource
  374. | stream |
  375. stream := '' writeStream.
  376. selectedClass ifNotNil: [
  377. stream
  378. nextPutAll: selectedClass superclass asString;
  379. nextPutAll: ' subclass: #';
  380. nextPutAll: selectedClass name;
  381. nextPutAll: String lf, String tab;
  382. nextPutAll: 'instanceVariableNames: '''.
  383. selectedClass instanceVariableNames
  384. do: [:each | stream nextPutAll: each]
  385. separatedBy: [stream nextPutAll: ' '].
  386. stream
  387. nextPutAll: '''', String lf, String tab;
  388. nextPutAll: 'category: ''';
  389. nextPutAll: selectedClass category;
  390. nextPutAll: ''''].
  391. ^stream contents
  392. !
  393. metaclassDeclarationSource
  394. | stream |
  395. stream := '' writeStream.
  396. selectedClass ifNotNil: [
  397. stream
  398. nextPutAll: selectedClass asString;
  399. nextPutAll: ' class ';
  400. nextPutAll: 'instanceVariableNames: '''.
  401. selectedClass class instanceVariableNames
  402. do: [:each | stream nextPutAll: each]
  403. separatedBy: [stream nextPutAll: ' '].
  404. stream nextPutAll: ''''].
  405. ^stream contents
  406. !
  407. classCommentSource
  408. ^selectedClass comment
  409. !
  410. selectedClass
  411. ^selectedClass
  412. ! !
  413. !Browser methodsFor: 'actions'!
  414. disableSaveButton
  415. saveButton ifNotNil: [
  416. saveButton at: 'disabled' put: true].
  417. unsavedChanges := false
  418. !
  419. hideClassButtons
  420. classButtons asJQuery hide
  421. !
  422. showClassButtons
  423. classButtons asJQuery show
  424. !
  425. hideMethodButtons
  426. methodButtons asJQuery hide
  427. !
  428. showMethodButtons
  429. methodButtons asJQuery show
  430. !
  431. compile
  432. self disableSaveButton.
  433. selectedTab = #comment
  434. ifTrue: [
  435. selectedClass ifNotNil: [
  436. self compileClassComment] ]
  437. ifFalse: [
  438. (selectedProtocol notNil or: [selectedMethod notNil])
  439. ifFalse: [self compileDefinition]
  440. ifTrue: [self compileMethodDefinition] ]
  441. !
  442. compileClassComment
  443. selectedClass comment: sourceArea val
  444. !
  445. compileMethodDefinition
  446. selectedTab = #instance
  447. ifTrue: [self compileMethodDefinitionFor: selectedClass]
  448. ifFalse: [self compileMethodDefinitionFor: selectedClass class]
  449. !
  450. compileMethodDefinitionFor: aClass
  451. | compiler method source node |
  452. source := sourceArea val.
  453. selectedProtocol ifNil: [selectedProtocol := selectedMethod category].
  454. compiler := Compiler new.
  455. compiler source: source.
  456. node := compiler parse: source.
  457. node isParseFailure ifTrue: [
  458. ^self alert: 'PARSE ERROR: ', node reason, ', position: ', node position asString].
  459. compiler currentClass: aClass.
  460. method := compiler eval: (compiler compileNode: node).
  461. method category: selectedProtocol.
  462. compiler unknownVariables do: [:each |
  463. (self confirm: 'Declare ''', each, ''' as instance variable?') ifTrue: [
  464. self addInstanceVariableNamed: each toClass: aClass.
  465. ^self compileMethodDefinitionFor: aClass]].
  466. aClass addCompiledMethod: method.
  467. compiler setupClass: aClass.
  468. self updateMethodsList.
  469. self selectMethod: method
  470. !
  471. compileDefinition
  472. | newClass |
  473. newClass := Compiler new loadExpression: sourceArea val.
  474. self
  475. resetClassesList;
  476. updateCategoriesList;
  477. updateClassesList
  478. !
  479. commitCategory
  480. selectedCategory ifNotNil: [
  481. (Ajax url: self class commitPathJs, '/', selectedCategory, '.js')
  482. at: 'type' put: 'PUT';
  483. at: 'data' put: (Exporter new exportCategory: selectedCategory);
  484. at: 'error' put: [self alert: 'Commit failed!!'];
  485. send.
  486. (Ajax url: self class commitPathJs, '/', selectedCategory, '.deploy.js')
  487. at: 'type' put: 'PUT';
  488. at: 'data' put: (StrippedExporter new exportCategory: selectedCategory);
  489. at: 'error' put: [self alert: 'Commit failed!!'];
  490. send.
  491. (Ajax url: self class commitPathSt, '/', selectedCategory, '.st')
  492. at: 'type' put: 'PUT';
  493. at: 'data' put: (ChunkExporter new exportCategory: selectedCategory);
  494. at: 'error' put: [self alert: 'Commit failed!!'];
  495. send]
  496. !
  497. cancelChanges
  498. ^unsavedChanges
  499. ifTrue: [self confirm: 'Cancel changes?']
  500. ifFalse: [true]
  501. !
  502. removeClass
  503. (self confirm: 'Do you really want to remove ', selectedClass name, '?')
  504. ifTrue: [
  505. Smalltalk current removeClass: selectedClass.
  506. self resetClassesList.
  507. self selectClass: nil]
  508. !
  509. removeMethod
  510. self cancelChanges ifTrue: [
  511. (self confirm: 'Do you really want to remove #', selectedMethod selector, '?')
  512. ifTrue: [
  513. selectedTab = #instance
  514. ifTrue: [selectedClass removeCompiledMethod: selectedMethod]
  515. ifFalse: [selectedClass class removeCompiledMethod: selectedMethod].
  516. self selectMethod: nil]]
  517. !
  518. setMethodProtocol: aString
  519. self cancelChanges ifTrue: [
  520. (self protocols includes: aString)
  521. ifFalse: [self addNewProtocol]
  522. ifTrue: [
  523. selectedMethod category: aString.
  524. selectedProtocol := aString.
  525. selectedMethod := selectedMethod.
  526. self
  527. updateProtocolsList;
  528. updateMethodsList;
  529. updateSourceAndButtons]]
  530. !
  531. addNewProtocol
  532. | newProtocol |
  533. newProtocol := self prompt: 'New method protocol'.
  534. newProtocol notEmpty ifTrue: [
  535. selectedMethod category: newProtocol.
  536. self setMethodProtocol: newProtocol]
  537. !
  538. selectCategory: aCategory
  539. self cancelChanges ifTrue: [
  540. selectedCategory := aCategory.
  541. selectedClass := selectedProtocol := selectedMethod := nil.
  542. self resetClassesList.
  543. self
  544. updateCategoriesList;
  545. updateClassesList;
  546. updateProtocolsList;
  547. updateMethodsList;
  548. updateSourceAndButtons]
  549. !
  550. selectClass: aClass
  551. self cancelChanges ifTrue: [
  552. selectedClass := aClass.
  553. selectedProtocol := selectedMethod := nil.
  554. self
  555. updateClassesList;
  556. updateProtocolsList;
  557. updateMethodsList;
  558. updateSourceAndButtons]
  559. !
  560. selectProtocol: aString
  561. self cancelChanges ifTrue: [
  562. selectedProtocol := aString.
  563. selectedMethod := nil.
  564. self
  565. updateProtocolsList;
  566. updateMethodsList;
  567. updateSourceAndButtons]
  568. !
  569. selectMethod: aMethod
  570. self cancelChanges ifTrue: [
  571. selectedMethod := aMethod.
  572. self
  573. updateProtocolsList;
  574. updateMethodsList;
  575. updateSourceAndButtons]
  576. !
  577. selectTab: aString
  578. self cancelChanges ifTrue: [
  579. selectedTab := aString.
  580. self selectProtocol: nil.
  581. self updateTabsList]
  582. !
  583. renameClass
  584. | newName |
  585. newName := self prompt: 'Rename class ', selectedClass name.
  586. newName notEmpty ifTrue: [
  587. selectedClass rename: newName.
  588. self
  589. updateClassesList;
  590. updateSourceAndButtons]
  591. !
  592. addInstanceVariableNamed: aString toClass: aClass
  593. ClassBuilder new
  594. addSubclassOf: aClass superclass named: aClass name instanceVariableNames: (aClass instanceVariableNames copy add: aString; yourself)
  595. !
  596. searchReferencesOf: aString
  597. ReferencesBrowser search: aString
  598. !
  599. searchClassReferences
  600. ReferencesBrowser search: selectedClass name
  601. !
  602. search: aString
  603. self cancelChanges ifTrue: [| searchedClass |
  604. searchedClass := Smalltalk current at: aString.
  605. searchedClass isClass
  606. ifTrue: [self class openOn: searchedClass]
  607. ifFalse: [self searchReferencesOf: aString]]
  608. ! !
  609. !Browser methodsFor: 'initialization'!
  610. initialize
  611. super initialize.
  612. selectedTab := #instance.
  613. unsavedChanges := false
  614. ! !
  615. !Browser methodsFor: 'rendering'!
  616. renderBoxOn: html
  617. self
  618. renderTopPanelOn: html;
  619. renderTabsOn: html;
  620. renderBottomPanelOn: html
  621. !
  622. renderTopPanelOn: html
  623. html div
  624. class: 'top';
  625. with: [
  626. self renderInputOn: html.
  627. categoriesList := html ul class: 'jt_column browser categories'.
  628. commitButton := html button
  629. class: 'jt_commit';
  630. title: 'Commit classes in this category to disk';
  631. onClick: [self commitCategory];
  632. with: 'Commit category'.
  633. classesList := ClassesList on: self.
  634. classesList renderOn: html.
  635. protocolsList := html ul class: 'jt_column browser protocols'.
  636. methodsList := html ul class: 'jt_column browser methods'.
  637. self
  638. updateCategoriesList;
  639. updateClassesList;
  640. updateProtocolsList;
  641. updateMethodsList.
  642. html div class: 'jt_clear']
  643. !
  644. renderTabsOn: html
  645. tabsList := html ul class: 'jt_tabs'.
  646. self updateTabsList.
  647. !
  648. renderBottomPanelOn: html
  649. html div
  650. class: 'jt_sourceCode';
  651. with: [
  652. sourceArea := SourceArea new.
  653. sourceArea renderOn: html.
  654. sourceArea onKeyUp: [self updateStatus]]
  655. !
  656. renderButtonsOn: html
  657. saveButton := html button.
  658. saveButton
  659. with: 'Save';
  660. onClick: [self compile].
  661. methodButtons := html span.
  662. classButtons := html span.
  663. html div
  664. class: 'right';
  665. with: [
  666. html button
  667. with: 'DoIt';
  668. onClick: [sourceArea doIt].
  669. html button
  670. with: 'PrintIt';
  671. onClick: [sourceArea printIt].
  672. html button with: 'InspectIt';
  673. onClick: [sourceArea inspectit]].
  674. self updateSourceAndButtons
  675. !
  676. renderInputOn: html
  677. input := html input
  678. class: 'implementors';
  679. yourself.
  680. input onKeyPress: [:event |
  681. event keyCode = 13 ifTrue: [
  682. self search: input asJQuery val]]
  683. ! !
  684. !Browser methodsFor: 'testing'!
  685. canBeClosed
  686. ^true
  687. ! !
  688. !Browser methodsFor: 'updating'!
  689. updateCategoriesList
  690. categoriesList contents: [:html |
  691. self categories do: [:each || li label |
  692. each isEmpty
  693. ifTrue: [label := 'Unclassified']
  694. ifFalse: [label := each].
  695. li := html li.
  696. selectedCategory = each ifTrue: [
  697. li class: 'selected'].
  698. li
  699. with: label;
  700. onClick: [self selectCategory: each]]]
  701. !
  702. updateClassesList
  703. TabManager current update.
  704. classesList updateNodes.
  705. "classesList contents: [:html |
  706. self classes do: [:each || li |
  707. li := html li.
  708. selectedClass = each ifTrue: [
  709. li class: 'selected'].
  710. li
  711. with: each name;
  712. onClick: [self selectClass: each]]]"
  713. !
  714. updateProtocolsList
  715. protocolsList contents: [:html |
  716. self protocols do: [:each || li |
  717. li := html li.
  718. selectedProtocol = each ifTrue: [
  719. li class: 'selected'].
  720. li
  721. with: each;
  722. onClick: [self selectProtocol: each]]]
  723. !
  724. updateMethodsList
  725. methodsList contents: [:html |
  726. self methods do: [:each || li |
  727. li := html li.
  728. selectedMethod = each ifTrue: [
  729. li class: 'selected'].
  730. li
  731. with: each selector;
  732. onClick: [self selectMethod: each]]]
  733. !
  734. updateTabsList
  735. tabsList contents: [:html || li |
  736. li := html li.
  737. selectedTab = #instance ifTrue: [li class: 'selected'].
  738. li
  739. with: 'Instance';
  740. onClick: [self selectTab: #instance].
  741. li := html li.
  742. selectedTab = #class ifTrue: [li class: 'selected'].
  743. li
  744. with: 'Class';
  745. onClick: [self selectTab: #class].
  746. li := html li.
  747. selectedTab = #comment ifTrue: [li class: 'selected'].
  748. li
  749. with: 'Comment';
  750. onClick: [self selectTab: #comment]]
  751. !
  752. updateSourceAndButtons
  753. self disableSaveButton.
  754. classButtons contents: [:html |
  755. html button
  756. with: 'Rename class';
  757. onClick: [self renameClass].
  758. html button
  759. with: 'Remove class';
  760. onClick: [self removeClass].
  761. html button
  762. with: 'References';
  763. onClick: [self searchClassReferences]].
  764. methodButtons contents: [:html |
  765. html button
  766. with: 'Remove method';
  767. onClick: [self removeMethod].
  768. html select
  769. onChange: [:e :select | self setMethodProtocol: select val];
  770. with: [
  771. html option
  772. with: 'Method protocol';
  773. at: 'disabled' put: 'disabled'.
  774. html option
  775. class: 'important';
  776. with: 'New...'.
  777. self protocols do: [:each |
  778. html option with: each]].
  779. selectedMethod isNil ifFalse: [
  780. html select
  781. onChange: [:e :select | self searchReferencesOf: select val];
  782. with: [
  783. html option
  784. with: 'References';
  785. at: 'disabled' put: 'disabled'.
  786. html option
  787. class: 'important';
  788. with: selectedMethod selector.
  789. selectedMethod messageSends sorted do: [:each |
  790. html option with: each]]]].
  791. selectedMethod isNil
  792. ifTrue: [
  793. self hideMethodButtons.
  794. (selectedClass isNil or: [selectedProtocol notNil])
  795. ifTrue: [self hideClassButtons]
  796. ifFalse: [self showClassButtons]]
  797. ifFalse: [
  798. self hideClassButtons.
  799. self showMethodButtons].
  800. sourceArea val: self source
  801. !
  802. updateStatus
  803. sourceArea val = self source
  804. ifTrue: [
  805. saveButton ifNotNil: [
  806. saveButton at: 'disabled' put: true].
  807. unsavedChanges := false]
  808. ifFalse: [
  809. saveButton ifNotNil: [
  810. saveButton removeAt: 'disabled'].
  811. unsavedChanges := true]
  812. !
  813. resetClassesList
  814. classesList resetNodes
  815. ! !
  816. !Browser class methodsFor: 'accessing'!
  817. commitPathJs
  818. ^'js'
  819. !
  820. commitPathSt
  821. ^'st'
  822. ! !
  823. !Browser class methodsFor: 'convenience'!
  824. openOn: aClass
  825. ^self new
  826. open;
  827. selectCategory: aClass category;
  828. selectClass: aClass
  829. !
  830. open
  831. self new open
  832. ! !
  833. TabWidget subclass: #Inspector
  834. instanceVariableNames: 'label variables object selectedVariable variablesList valueTextarea diveButton sourceArea'
  835. category: 'IDE'!
  836. !Inspector methodsFor: 'accessing'!
  837. label
  838. ^label ifNil: ['Inspector (nil)']
  839. !
  840. variables
  841. ^variables
  842. !
  843. setVariables: aCollection
  844. variables := aCollection
  845. !
  846. setLabel: aString
  847. label := aString
  848. !
  849. selectedVariable
  850. ^selectedVariable
  851. !
  852. selectedVariable: aString
  853. selectedVariable := aString
  854. !
  855. sourceArea
  856. ^sourceArea
  857. ! !
  858. !Inspector methodsFor: 'actions'!
  859. inspect: anObject
  860. object := anObject.
  861. variables := #().
  862. object inspectOn: self
  863. !
  864. dive
  865. (self variables at: self selectedVariable) inspect
  866. !
  867. refresh
  868. self
  869. inspect: object;
  870. updateVariablesList;
  871. updateValueTextarea
  872. ! !
  873. !Inspector methodsFor: 'rendering'!
  874. renderBoxOn: html
  875. self
  876. renderTopPanelOn: html;
  877. renderBottomPanelOn: html
  878. !
  879. renderTopPanelOn: html
  880. html div
  881. class: 'top';
  882. with: [
  883. variablesList := html ul class: 'jt_column variables'.
  884. valueTextarea := html textarea class: 'jt_column value'; at: 'readonly' put: 'readonly'.
  885. html div class: 'jt_buttons inspector'; with: [
  886. html button
  887. class: 'jt_button inspector refresh';
  888. with: 'Refresh';
  889. onClick: [self refresh].
  890. diveButton := html button
  891. class: 'jt_button inspector dive';
  892. with: 'Dive';
  893. onClick: [self dive]].
  894. html div class: 'jt_clear'].
  895. self
  896. updateVariablesList;
  897. updateValueTextarea.
  898. !
  899. renderBottomPanelOn: html
  900. html div
  901. class: 'jt_sourceCode';
  902. with: [
  903. sourceArea := SourceArea new
  904. receiver: object;
  905. onDoIt: [self refresh];
  906. yourself.
  907. sourceArea renderOn: html]
  908. !
  909. renderButtonsOn: html
  910. html button
  911. with: 'DoIt';
  912. onClick: [self sourceArea doIt].
  913. html button
  914. with: 'PrintIt';
  915. onClick: [self sourceArea printIt].
  916. html button
  917. with: 'InspectIt';
  918. onClick: [self sourceArea inspectIt].
  919. self updateButtons
  920. ! !
  921. !Inspector methodsFor: 'testing'!
  922. canBeClosed
  923. ^true
  924. ! !
  925. !Inspector methodsFor: 'updating'!
  926. updateVariablesList
  927. variablesList contents: [:html |
  928. self variables keys do: [:each || li |
  929. li := html li.
  930. li
  931. with: each;
  932. onClick: [self selectVariable: each].
  933. self selectedVariable = each ifTrue: [
  934. li class: 'selected']]]
  935. !
  936. selectVariable: aString
  937. self selectedVariable: aString.
  938. self
  939. updateVariablesList;
  940. updateValueTextarea;
  941. updateButtons
  942. !
  943. updateValueTextarea
  944. valueTextarea asJQuery val: (self selectedVariable isNil
  945. ifTrue: ['']
  946. ifFalse: [(self variables at: self selectedVariable) printString])
  947. !
  948. updateButtons
  949. (self selectedVariable notNil and: [(self variables at: self selectedVariable) notNil])
  950. ifFalse: [diveButton at: 'disabled' put: true]
  951. ifTrue: [diveButton removeAt: 'disabled']
  952. ! !
  953. !Inspector class methodsFor: 'instance creation'!
  954. on: anObject
  955. ^self new
  956. inspect: anObject;
  957. yourself
  958. ! !
  959. TabWidget subclass: #ReferencesBrowser
  960. instanceVariableNames: 'implementors senders implementorsList input timer selector sendersList referencedClasses referencedClassesList'
  961. category: 'IDE'!
  962. !ReferencesBrowser methodsFor: 'accessing'!
  963. implementors
  964. ^implementors ifNil: [implementors := Array new]
  965. !
  966. label
  967. ^'[ReferencesBrowser]'
  968. !
  969. selector
  970. ^selector
  971. !
  972. senders
  973. ^senders ifNil: [senders := Array new]
  974. !
  975. classesAndMetaclasses
  976. ^Smalltalk current classes, (Smalltalk current classes collect: [:each | each class])
  977. !
  978. referencedClasses
  979. ^referencedClasses ifNil: [referencedClasses := Array new]
  980. ! !
  981. !ReferencesBrowser methodsFor: 'actions'!
  982. openBrowserOn: aMethod
  983. | browser |
  984. browser := Browser openOn: (aMethod class isMetaclass
  985. ifTrue: [aMethod methodClass instanceClass] ifFalse: [aMethod methodClass]).
  986. aMethod methodClass isMetaclass ifTrue: [browser selectTab: #class].
  987. browser
  988. selectProtocol: aMethod category;
  989. selectMethod: aMethod
  990. !
  991. searchReferencesFor: aString
  992. selector := aString.
  993. implementors := Array new.
  994. senders := Array new.
  995. referencedClasses := Array new.
  996. (selector match: '^[A-Z]')
  997. ifFalse: [self searchSelectorReferencesFor: selector]
  998. ifTrue: [self searchReferencedClassesFor: selector]
  999. !
  1000. search: aString
  1001. self
  1002. searchReferencesFor: aString;
  1003. updateImplementorsList;
  1004. updateSendersList;
  1005. updateReferencedClassesList
  1006. !
  1007. searchReferencedClassesFor: aString
  1008. self classesAndMetaclasses do: [:each |
  1009. each methodDictionary values do: [:value |
  1010. (((value referencedClasses select: [:each | each notNil])collect: [:each | each name]) includes: selector) ifTrue: [
  1011. self referencedClasses add: value]]]
  1012. !
  1013. searchSelectorReferencesFor: aString
  1014. self classesAndMetaclasses do: [:each |
  1015. each methodDictionary keysAndValuesDo: [:key :value |
  1016. key = selector ifTrue: [self implementors add: value]].
  1017. each methodDictionary keysAndValuesDo: [:key :value |
  1018. (value messageSends includes: selector) ifTrue: [
  1019. self senders add: value]]]
  1020. ! !
  1021. !ReferencesBrowser methodsFor: 'initialization'!
  1022. initialize
  1023. super initialize.
  1024. selector := ''
  1025. ! !
  1026. !ReferencesBrowser methodsFor: 'private'!
  1027. setInputEvents
  1028. input
  1029. onKeyUp: [timer := [self search: input asJQuery val] valueWithTimeout: 100];
  1030. onKeyDown: [timer ifNotNil: [timer clearTimeout]]
  1031. ! !
  1032. !ReferencesBrowser methodsFor: 'rendering'!
  1033. renderBoxOn: html
  1034. self
  1035. renderInputOn: html;
  1036. renderImplementorsOn: html;
  1037. renderSendersOn: html;
  1038. renderReferencedClassesOn: html
  1039. !
  1040. renderInputOn: html
  1041. input := html input
  1042. class: 'implementors';
  1043. yourself.
  1044. input asJQuery val: selector.
  1045. self setInputEvents
  1046. !
  1047. renderImplementorsOn: html
  1048. implementorsList := html ul class: 'jt_column implementors'.
  1049. self updateImplementorsList
  1050. !
  1051. renderSendersOn: html
  1052. sendersList := html ul class: 'jt_column senders'.
  1053. self updateSendersList
  1054. !
  1055. renderReferencedClassesOn: html
  1056. referencedClassesList := html ul class: 'jt_column referenced_classes'.
  1057. self updateReferencedClassesList
  1058. ! !
  1059. !ReferencesBrowser methodsFor: 'testing'!
  1060. canBeClosed
  1061. ^true
  1062. ! !
  1063. !ReferencesBrowser methodsFor: 'updating'!
  1064. updateImplementorsList
  1065. implementorsList contents: [:html |
  1066. html li
  1067. class: 'column_label';
  1068. with: 'Implementors (', self implementors size asString, ')';
  1069. style: 'font-weight: bold'.
  1070. self implementors do: [:each || li |
  1071. li := html li.
  1072. li
  1073. with: (each methodClass asString, ' >> ', self selector);
  1074. onClick: [self openBrowserOn: each]]]
  1075. !
  1076. updateSendersList
  1077. sendersList contents: [:html |
  1078. html li
  1079. class: 'column_label';
  1080. with: 'Senders (', self senders size asString, ')';
  1081. style: 'font-weight: bold'.
  1082. self senders do: [:each |
  1083. html li
  1084. with: (each methodClass asString, ' >> ', each selector);
  1085. onClick: [self openBrowserOn: each]]]
  1086. !
  1087. updateReferencedClassesList
  1088. referencedClassesList contents: [:html |
  1089. html li
  1090. class: 'column_label';
  1091. with: 'Class references (', self referencedClasses size asString, ')';
  1092. style: 'font-weight: bold'.
  1093. self referencedClasses do: [:each |
  1094. html li
  1095. with: (each methodClass asString, ' >> ', each selector);
  1096. onClick: [self openBrowserOn: each]]]
  1097. ! !
  1098. !ReferencesBrowser class methodsFor: 'instance creation'!
  1099. search: aString
  1100. ^self new
  1101. searchReferencesFor: aString;
  1102. open
  1103. ! !
  1104. Widget subclass: #SourceArea
  1105. instanceVariableNames: 'editor div receiver onDoIt'
  1106. category: 'IDE'!
  1107. !SourceArea methodsFor: 'accessing'!
  1108. val
  1109. ^editor getValue
  1110. !
  1111. val: aString
  1112. editor setValue: aString
  1113. !
  1114. currentLine
  1115. ^editor getLine: (editor getCursor line)
  1116. !
  1117. selection
  1118. ^editor getSelection
  1119. !
  1120. selectionEnd
  1121. ^textarea element selectionEnd
  1122. !
  1123. selectionStart
  1124. ^textarea element selectionStart
  1125. !
  1126. selectionStart: anInteger
  1127. textarea element selectionStart: anInteger
  1128. !
  1129. selectionEnd: anInteger
  1130. textarea element selectionEnd: anInteger
  1131. !
  1132. setEditorOn: aTextarea
  1133. <self['@editor'] = CodeMirror.fromTextArea(aTextarea, {
  1134. theme: 'jtalk',
  1135. lineNumbers: true,
  1136. enterMode: 'classic',
  1137. matchBrackets: true,
  1138. electricChars: false,
  1139. })>
  1140. !
  1141. editor
  1142. ^editor
  1143. !
  1144. receiver
  1145. ^receiver ifNil: [DoIt new]
  1146. !
  1147. receiver: anObject
  1148. receiver := anObject
  1149. !
  1150. onDoIt: aBlock
  1151. onDoIt := aBlock
  1152. !
  1153. onDoIt
  1154. ^onDoIt
  1155. ! !
  1156. !SourceArea methodsFor: 'actions'!
  1157. clear
  1158. textarea asJQuery val: ''
  1159. !
  1160. doIt
  1161. | selection result |
  1162. editor somethingSelected
  1163. ifFalse: [selection := self currentLine]
  1164. ifTrue: [selection := self selection].
  1165. result := self eval: selection.
  1166. self onDoIt ifNotNil: [self onDoIt value].
  1167. ^result
  1168. !
  1169. eval: aString
  1170. | compiler |
  1171. compiler := Compiler new.
  1172. [compiler parseExpression: aString] on: Error do: [:ex |
  1173. ^self alert: ex messageText].
  1174. ^(compiler load: 'doIt ^[', aString, '] value' forClass: DoIt) fn applyTo: self receiver arguments: #()
  1175. !
  1176. handleKeyDown: anEvent
  1177. <if(anEvent.ctrlKey) {
  1178. if(anEvent.keyCode === 80) { //ctrl+p
  1179. self._printIt();
  1180. anEvent.preventDefault();
  1181. return false;
  1182. }
  1183. if(anEvent.keyCode === 68) { //ctrl+d
  1184. self._doIt();
  1185. anEvent.preventDefault();
  1186. return false;
  1187. }
  1188. if(anEvent.keyCode === 73) { //ctrl+i
  1189. self._inspectIt();
  1190. anEvent.preventDefault();
  1191. return false;
  1192. }
  1193. }>
  1194. !
  1195. inspectIt
  1196. self doIt inspect
  1197. !
  1198. print: aString
  1199. | start stop |
  1200. start := Dictionary new.
  1201. stop := Dictionary new.
  1202. start at: 'line' put: (editor getCursor: false) line.
  1203. start at: 'ch' put: (editor getCursor: false) ch.
  1204. stop at: 'line' put: (start at: 'line').
  1205. stop at: 'ch' put: ((start at: 'ch') + aString size + 2).
  1206. editor replaceSelection: (editor getSelection, ' ', aString, ' ').
  1207. editor setCursor: (editor getCursor: true).
  1208. editor setSelection: stop end: start
  1209. !
  1210. printIt
  1211. self print: self doIt printString
  1212. ! !
  1213. !SourceArea methodsFor: 'events'!
  1214. onKeyUp: aBlock
  1215. div onKeyUp: aBlock
  1216. !
  1217. onKeyDown: aBlock
  1218. div onKeyDown: aBlock
  1219. ! !
  1220. !SourceArea methodsFor: 'rendering'!
  1221. renderOn: html
  1222. | textarea |
  1223. div := html div class: 'source'.
  1224. div with: [textarea := html textarea].
  1225. self setEditorOn: textarea element.
  1226. div onKeyDown: [:e | self handleKeyDown: e]
  1227. ! !
  1228. Widget subclass: #ClassesList
  1229. instanceVariableNames: 'browser ul nodes'
  1230. category: 'IDE'!
  1231. !ClassesList methodsFor: 'accessing'!
  1232. category
  1233. ^self browser selectedCategory
  1234. !
  1235. nodes
  1236. nodes ifNil: [nodes := self getNodes].
  1237. ^nodes
  1238. !
  1239. browser
  1240. ^browser
  1241. !
  1242. browser: aBrowser
  1243. browser := aBrowser
  1244. !
  1245. getNodes
  1246. | classes children others |
  1247. classes := self browser classes.
  1248. children := #().
  1249. others := #().
  1250. classes do: [:each |
  1251. (classes includes: each superclass)
  1252. ifFalse: [children add: each]
  1253. ifTrue: [others add: each]].
  1254. ^children collect: [:each |
  1255. ClassesListNode on: each browser: self browser classes: others level: 0]
  1256. !
  1257. resetNodes
  1258. nodes := nil
  1259. ! !
  1260. !ClassesList methodsFor: 'rendering'!
  1261. renderOn: html
  1262. ul := html ul
  1263. class: 'jt_column browser classes';
  1264. yourself.
  1265. self updateNodes
  1266. !
  1267. updateNodes
  1268. ul contents: [:html |
  1269. self nodes do: [:each |
  1270. each renderOn: html]]
  1271. ! !
  1272. !ClassesList class methodsFor: 'instance creation'!
  1273. on: aBrowser
  1274. ^self new
  1275. browser: aBrowser;
  1276. yourself
  1277. ! !
  1278. Widget subclass: #ClassesListNode
  1279. instanceVariableNames: 'browser theClass level nodes'
  1280. category: 'IDE'!
  1281. !ClassesListNode methodsFor: ''!
  1282. renderOn: html
  1283. | li cssClass |
  1284. cssClass := ''.
  1285. li := html li
  1286. onClick: [self browser selectClass: self theClass].
  1287. li asJQuery contents: self label.
  1288. self browser selectedClass = self theClass ifTrue: [
  1289. cssClass := cssClass, ' selected'].
  1290. self theClass comment isEmpty ifFalse: [
  1291. cssClass := cssClass, ' commented'].
  1292. li class: cssClass.
  1293. self nodes do: [:each |
  1294. each renderOn: html]
  1295. ! !
  1296. !ClassesListNode methodsFor: 'accessing'!
  1297. nodes
  1298. ^nodes
  1299. !
  1300. theClass
  1301. ^theClass
  1302. !
  1303. theClass: aClass
  1304. theClass := aClass
  1305. !
  1306. browser
  1307. ^browser
  1308. !
  1309. browser: aBrowser
  1310. browser := aBrowser
  1311. !
  1312. level
  1313. ^level
  1314. !
  1315. level: anInteger
  1316. level := anInteger
  1317. !
  1318. label
  1319. | str |
  1320. str := String new writeStream.
  1321. self level timesRepeat: [
  1322. str nextPutAll: '&nbsp;&nbsp;&nbsp;&nbsp;'].
  1323. str nextPutAll: self theClass name.
  1324. ^str contents
  1325. !
  1326. getNodesFrom: aCollection
  1327. | children others |
  1328. children := #().
  1329. others := #().
  1330. aCollection do: [:each |
  1331. (each superclass = self theClass)
  1332. ifTrue: [children add: each]
  1333. ifFalse: [others add: each]].
  1334. nodes:= children collect: [:each |
  1335. ClassesListNode on: each browser: self browser classes: others level: self level + 1]
  1336. ! !
  1337. !ClassesListNode class methodsFor: 'instance creation'!
  1338. on: aClass browser: aBrowser classes: aCollection level: anInteger
  1339. ^self new
  1340. theClass: aClass;
  1341. browser: aBrowser;
  1342. level: anInteger;
  1343. getNodesFrom: aCollection;
  1344. yourself
  1345. ! !
  1346. TabWidget subclass: #Debugger
  1347. instanceVariableNames: 'error selectedContext sourceArea ul ul2 inspector saveButton unsavedChanges selectedVariable selectedVariableName inspectButton'
  1348. category: 'IDE'!
  1349. !Debugger methodsFor: 'accessing'!
  1350. error
  1351. ^error
  1352. !
  1353. error: anError
  1354. error := anError
  1355. !
  1356. label
  1357. ^'[Debugger]'
  1358. !
  1359. source
  1360. ^self method
  1361. ifNil: ['Method doesn''t exist!!']
  1362. ifNotNil: [self method source]
  1363. !
  1364. method
  1365. ^selectedContext receiver class methodAt: selectedContext selector
  1366. !
  1367. arguments
  1368. ^self method
  1369. ifNil: [selectedContext temps collect: [:each | nil]]
  1370. ifNotNil: [self method arguments]
  1371. !
  1372. receiver
  1373. ^selectedContext receiver
  1374. ! !
  1375. !Debugger methodsFor: 'actions'!
  1376. selectContext: aContext
  1377. selectedContext := aContext.
  1378. selectedVariable := nil.
  1379. selectedVariableName := nil.
  1380. self
  1381. updateContextsList;
  1382. updateSourceArea;
  1383. updateInspector;
  1384. updateVariablesList;
  1385. updateStatus
  1386. !
  1387. proceed
  1388. self close.
  1389. selectedContext receiver perform: selectedContext selector withArguments: selectedContext temps
  1390. !
  1391. save
  1392. | protocol |
  1393. protocol := (selectedContext receiver class methodDictionary at: selectedContext selector) category.
  1394. selectedContext receiver class compile: sourceArea val category: protocol.
  1395. self updateStatus
  1396. !
  1397. selectVariable: anObject named: aString
  1398. selectedVariable := anObject.
  1399. selectedVariableName := aString.
  1400. inspector contents: [:html | html with: anObject printString].
  1401. self updateVariablesList
  1402. !
  1403. inspectSelectedVariable
  1404. selectedVariable inspect
  1405. ! !
  1406. !Debugger methodsFor: 'initialization'!
  1407. initialize
  1408. super initialize.
  1409. unsavedChanges = false
  1410. ! !
  1411. !Debugger methodsFor: 'rendering'!
  1412. renderTopPanelOn: html
  1413. selectedContext := self error context.
  1414. html div
  1415. class: 'top';
  1416. with: [
  1417. html div
  1418. class: 'label';
  1419. with: self error messageText.
  1420. ul := html ul
  1421. class: 'jt_column debugger contexts';
  1422. with: [self renderContext: self error context on: html]]
  1423. !
  1424. renderContext: aContext on: html
  1425. | li |
  1426. li := html li.
  1427. selectedContext = aContext ifTrue: [
  1428. li class: 'selected'].
  1429. li
  1430. with: aContext asString;
  1431. onClick: [self selectContext: aContext].
  1432. aContext home ifNotNil: [self renderContext: aContext home on: html]
  1433. !
  1434. renderBottomPanelOn: html
  1435. html div
  1436. class: 'jt_sourceCode debugger';
  1437. with: [
  1438. sourceArea := SourceArea new.
  1439. sourceArea renderOn: html].
  1440. ul2 := html ul class: 'jt_column debugger variables'.
  1441. inspector := html div class: 'jt_column debugger inspector'.
  1442. sourceArea
  1443. onKeyUp: [self updateStatus]
  1444. !
  1445. renderButtonsOn: html
  1446. saveButton := html button
  1447. with: 'Save';
  1448. onClick: [self save].
  1449. html button
  1450. with: 'DoIt';
  1451. onClick: [sourceArea doIt].
  1452. html button
  1453. with: 'PrintIt';
  1454. onClick: [sourceArea printIt].
  1455. html button
  1456. with: 'InspectIt';
  1457. onClick: [sourceArea inspectIt].
  1458. html button
  1459. with: 'Proceed';
  1460. onClick: [self proceed].
  1461. html button
  1462. with: 'Abandon';
  1463. onClick: [self close].
  1464. inspectButton := html button
  1465. class: 'jt_button debugger inspect';
  1466. with: 'Inspect';
  1467. onClick: [self inspectSelectedVariable].
  1468. self
  1469. updateSourceArea;
  1470. updateStatus;
  1471. updateVariablesList;
  1472. updateInspector
  1473. !
  1474. renderBoxOn: html
  1475. self
  1476. renderTopPanelOn: html;
  1477. renderBottomPanelOn: html
  1478. ! !
  1479. !Debugger methodsFor: 'testing'!
  1480. canBeClosed
  1481. ^true
  1482. ! !
  1483. !Debugger methodsFor: 'updating'!
  1484. updateContextsList
  1485. ul contents: [:html |
  1486. self renderContext: self error context on: html]
  1487. !
  1488. updateSourceArea
  1489. sourceArea val: self source
  1490. !
  1491. updateStatus
  1492. sourceArea val = self source
  1493. ifTrue: [
  1494. saveButton ifNotNil: [
  1495. saveButton at: 'disabled' put: true].
  1496. unsavedChanges := false]
  1497. ifFalse: [
  1498. saveButton ifNotNil: [
  1499. saveButton removeAt: 'disabled'].
  1500. unsavedChanges := true]
  1501. !
  1502. updateInspector
  1503. inspector contents: [:html |]
  1504. !
  1505. updateVariablesList
  1506. ul2 contents: [:html | | li |
  1507. li := html li
  1508. with: 'self';
  1509. onClick: [self selectVariable: self receiver named: 'self'].
  1510. selectedVariableName = 'self' ifTrue: [
  1511. li class: 'selected'].
  1512. self arguments withIndexDo: [:each :index | | param |
  1513. param := selectedContext temps at: index.
  1514. li := html li
  1515. with: each;
  1516. onClick: [self selectVariable: param named: each].
  1517. selectedVariableName = each ifTrue: [
  1518. li class: 'selected']].
  1519. self receiver class allInstanceVariableNames do: [:each | | ivar |
  1520. ivar := self receiver instVarAt: each.
  1521. li := html li
  1522. with: each;
  1523. onClick: [self selectVariable: ivar named: each].
  1524. selectedVariableName = each ifTrue: [
  1525. li class: 'selected']]].
  1526. selectedVariable ifNil: [inspectButton at: 'disabled' put: true] ifNotNil: [inspectButton removeAt: 'disabled']
  1527. ! !
  1528. ErrorHandler subclass: #DebugErrorHandler
  1529. instanceVariableNames: ''
  1530. category: 'IDE'!
  1531. !DebugErrorHandler methodsFor: 'error handling'!
  1532. handleError: anError
  1533. [Debugger new
  1534. error: anError;
  1535. open] on: Error do: [:error |
  1536. ErrorHandler new handleError: error]
  1537. ! !
  1538. !DebugErrorHandler class methodsFor: 'initialization'!
  1539. initialize
  1540. self register
  1541. ! !
  1542. TabWidget subclass: #ProgressBar
  1543. instanceVariableNames: 'percent progressDiv div'
  1544. category: 'IDE'!
  1545. !ProgressBar methodsFor: 'accessing'!
  1546. percent
  1547. ^percent ifNil: [0]
  1548. !
  1549. percent: aNumber
  1550. percent := aNumber
  1551. ! !
  1552. !ProgressBar methodsFor: 'rendering'!
  1553. renderOn: html
  1554. div := html div
  1555. class: 'progress_bar';
  1556. yourself.
  1557. self renderProgressBar
  1558. !
  1559. renderProgressBar
  1560. div contents: [:html |
  1561. html div
  1562. class: 'progress';
  1563. style: 'width:', self percent asString, '%']
  1564. ! !
  1565. !ProgressBar methodsFor: 'updating'!
  1566. updatePercent: aNumber
  1567. self percent: aNumber.
  1568. self renderProgressBar
  1569. ! !
  1570. TabWidget subclass: #TestRunner
  1571. instanceVariableNames: 'selectedCategories categoriesList selectedClasses classesList selectedMethods progressBar methodsList result statusDiv'
  1572. category: 'IDE'!
  1573. !TestRunner methodsFor: 'accessing'!
  1574. label
  1575. ^'[SUnit]'
  1576. !
  1577. categories
  1578. | categories |
  1579. categories := Array new.
  1580. self allClasses do: [:each |
  1581. (categories includes: each category) ifFalse: [
  1582. categories add: each category]].
  1583. ^categories sort
  1584. !
  1585. classes
  1586. ^(self allClasses
  1587. select: [:each | self selectedCategories includes: each category])
  1588. sort: [:a :b | a name > b name]
  1589. !
  1590. selectedCategories
  1591. ^selectedCategories ifNil: [selectedCategories := Array new]
  1592. !
  1593. allClasses
  1594. ^TestCase allSubclasses
  1595. !
  1596. selectedClasses
  1597. ^selectedClasses ifNil: [selectedClasses := Array new]
  1598. !
  1599. progressBar
  1600. ^progressBar ifNil: [progressBar := ProgressBar new]
  1601. !
  1602. statusInfo
  1603. ^self printTotal, self printPasses, self printErrors, self printFailures
  1604. !
  1605. result
  1606. ^result
  1607. !
  1608. testCases
  1609. | testCases |
  1610. testCases := #().
  1611. self selectedClasses do: [:each | testCases addAll: each buildSuite].
  1612. ^testCases
  1613. ! !
  1614. !TestRunner methodsFor: 'actions'!
  1615. selectAllCategories
  1616. self categories do: [:each |
  1617. (selectedCategories includes: each) ifFalse: [
  1618. self selectedCategories add: each]].
  1619. self
  1620. updateCategoriesList;
  1621. updateClassesList
  1622. !
  1623. toggleCategory: aCategory
  1624. (self isSelectedCategory: aCategory)
  1625. ifFalse: [selectedCategories add: aCategory]
  1626. ifTrue: [selectedCategories remove: aCategory].
  1627. self
  1628. updateCategoriesList;
  1629. updateClassesList
  1630. !
  1631. toggleClass: aClass
  1632. (self isSelectedClass: aClass)
  1633. ifFalse: [selectedClasses add: aClass]
  1634. ifTrue: [selectedClasses remove: aClass].
  1635. self
  1636. updateClassesList
  1637. !
  1638. selectAllClasses
  1639. self classes do: [:each |
  1640. (selectedClasses includes: each) ifFalse: [
  1641. self selectedClasses add: each]].
  1642. self
  1643. updateCategoriesList;
  1644. updateClassesList
  1645. !
  1646. run: aCollection
  1647. result := TestResult new.
  1648. self
  1649. updateStatusDiv;
  1650. updateMethodsList.
  1651. self progressBar updatePercent: 0.
  1652. result total: aCollection size.
  1653. aCollection do: [:each |
  1654. [each runCaseFor: result.
  1655. self progressBar updatePercent: result runs / result total * 100.
  1656. self updateStatusDiv.
  1657. self updateMethodsList] valueWithTimeout: 100].
  1658. !
  1659. performFailure: aTestCase
  1660. aTestCase perform: aTestCase selector
  1661. ! !
  1662. !TestRunner methodsFor: 'initialization'!
  1663. initialize
  1664. super initialize.
  1665. result := TestResult new
  1666. ! !
  1667. !TestRunner methodsFor: 'printing'!
  1668. printErrors
  1669. ^self result errors size asString , ' errors, '
  1670. !
  1671. printFailures
  1672. ^self result failures size asString, ' failures'
  1673. !
  1674. printPasses
  1675. ^(self result total - self result errors size - self result failures size) asString , ' passes, '
  1676. !
  1677. printTotal
  1678. ^self result total asString, ' runs, '
  1679. ! !
  1680. !TestRunner methodsFor: 'rendering'!
  1681. renderBoxOn: html
  1682. self
  1683. renderCategoriesOn: html;
  1684. renderClassesOn: html;
  1685. renderResultsOn: html
  1686. !
  1687. renderButtonsOn: html
  1688. html button
  1689. with: 'Run selected';
  1690. onClick: [self run: self testCases]
  1691. !
  1692. renderCategoriesOn: html
  1693. categoriesList := html ul class: 'jt_column sunit categories'.
  1694. self updateCategoriesList
  1695. !
  1696. renderClassesOn: html
  1697. classesList := html ul class: 'jt_column sunit classes'.
  1698. self updateClassesList
  1699. !
  1700. renderResultsOn: html
  1701. statusDiv := html div.
  1702. html with: self progressBar.
  1703. methodsList := html ul class: 'jt_column sunit methods'.
  1704. self updateMethodsList.
  1705. self updateStatusDiv
  1706. !
  1707. renderFailuresOn: html
  1708. self result failures do: [:each |
  1709. html li
  1710. class: 'failures';
  1711. with: each class name, ' >> ', each selector;
  1712. onClick: [self performFailure: each]]
  1713. !
  1714. renderErrorsOn: html
  1715. self result errors do: [:each |
  1716. html li
  1717. class: 'errors';
  1718. with: each class name, ' >> ', each selector;
  1719. onClick: [self performFailure: each]]
  1720. ! !
  1721. !TestRunner methodsFor: 'testing'!
  1722. isSelectedClass: aClass
  1723. ^(self selectedClasses includes: aClass)
  1724. !
  1725. isSelectedCategory: aCategory
  1726. ^(self selectedCategories includes: aCategory)
  1727. ! !
  1728. !TestRunner methodsFor: 'updating'!
  1729. updateCategoriesList
  1730. categoriesList contents: [:html |
  1731. html li
  1732. class: 'all';
  1733. with: 'All';
  1734. onClick: [self selectAllCategories].
  1735. self categories do: [:each || li |
  1736. li := html li.
  1737. (self selectedCategories includes: each) ifTrue: [
  1738. li class: 'selected'].
  1739. li
  1740. with: each;
  1741. onClick: [self toggleCategory: each]]]
  1742. !
  1743. updateClassesList
  1744. classesList contents: [:html |
  1745. (self selectedCategories isEmpty) ifFalse: [
  1746. html li
  1747. class: 'all';
  1748. with: 'All';
  1749. onClick: [self selectAllClasses]].
  1750. self classes do: [:each || li |
  1751. li := html li.
  1752. (self selectedClasses includes: each) ifTrue: [
  1753. li class: 'selected'].
  1754. li
  1755. with: each name;
  1756. onClick: [self toggleClass: each]]]
  1757. !
  1758. updateMethodsList
  1759. methodsList contents: [:html |
  1760. self renderErrorsOn: html.
  1761. self renderFailuresOn: html]
  1762. !
  1763. updateStatusDiv
  1764. statusDiv class: 'sunit status ', result status.
  1765. statusDiv contents: [:html |
  1766. html span with: self statusInfo]
  1767. ! !
  1768. !Object methodsFor: '*IDE'!
  1769. inspect
  1770. Inspector new
  1771. inspect: self;
  1772. open
  1773. !
  1774. inspectOn: anInspector
  1775. | variables |
  1776. variables := Dictionary new.
  1777. variables at: '#self' put: self.
  1778. self class allInstanceVariableNames do: [:each |
  1779. variables at: each put: (self instVarAt: each)].
  1780. anInspector
  1781. setLabel: self printString;
  1782. setVariables: variables
  1783. ! !
  1784. !Date methodsFor: '*IDE'!
  1785. inspectOn: anInspector
  1786. | variables |
  1787. variables := Dictionary new.
  1788. variables at: '#self' put: self.
  1789. variables at: '#year' put: self year.
  1790. variables at: '#month' put: self month.
  1791. variables at: '#day' put: self day.
  1792. variables at: '#hours' put: self hours.
  1793. variables at: '#minutes' put: self minutes.
  1794. variables at: '#seconds' put: self seconds.
  1795. variables at: '#milliseconds' put: self milliseconds.
  1796. anInspector
  1797. setLabel: self printString;
  1798. setVariables: variables
  1799. ! !
  1800. !Collection methodsFor: '*IDE'!
  1801. inspectOn: anInspector
  1802. | variables |
  1803. variables := Dictionary new.
  1804. variables at: '#self' put: self.
  1805. self withIndexDo: [:each :i |
  1806. variables at: i put: each].
  1807. anInspector
  1808. setLabel: self printString;
  1809. setVariables: variables
  1810. ! !
  1811. !String methodsFor: '*IDE'!
  1812. inspectOn: anInspector
  1813. | label |
  1814. super inspectOn: anInspector.
  1815. self printString size > 30
  1816. ifTrue: [label := (self printString copyFrom: 1 to: 30), '...''']
  1817. ifFalse: [label := self printString].
  1818. anInspector setLabel: label
  1819. ! !
  1820. !MethodContext methodsFor: '*IDE'!
  1821. inspectOn: anInspector
  1822. | variables |
  1823. variables := Dictionary new.
  1824. variables at: '#self' put: self.
  1825. variables at: '#home' put: self home.
  1826. variables at: '#receiver' put: self receiver.
  1827. variables at: '#selector' put: self selector.
  1828. variables at: '#temps' put: self temps.
  1829. self class instanceVariableNames do: [:each |
  1830. variables at: each put: (self instVarAt: each)].
  1831. anInspector
  1832. setLabel: self printString;
  1833. setVariables: variables
  1834. ! !
  1835. !Dictionary methodsFor: '*IDE'!
  1836. inspectOn: anInspector
  1837. | variables |
  1838. variables := Dictionary new.
  1839. variables at: '#self' put: self.
  1840. variables at: '#keys' put: self keys.
  1841. self keysAndValuesDo: [:key :value |
  1842. variables at: key put: value].
  1843. anInspector
  1844. setLabel: self printString;
  1845. setVariables: variables
  1846. ! !