1
0

Helios-Core.st 25 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330
  1. Smalltalk current createPackage: 'Helios-Core'!
  2. Object subclass: #HLModel
  3. instanceVariableNames: 'announcer environment'
  4. package: 'Helios-Core'!
  5. !HLModel methodsFor: 'accessing'!
  6. announcer
  7. ^ announcer ifNil: [ announcer := Announcer new ]
  8. !
  9. environment
  10. ^ environment ifNil: [ self manager environment ]
  11. !
  12. environment: anEnvironment
  13. environment := anEnvironment
  14. !
  15. manager
  16. ^ HLManager current
  17. !
  18. systemAnnouncer
  19. ^ self environment systemAnnouncer
  20. ! !
  21. !HLModel methodsFor: 'error handling'!
  22. withChangesDo: aBlock
  23. [
  24. self announcer announce: (HLAboutToChange new
  25. actionBlock: aBlock).
  26. aBlock value.
  27. ]
  28. on: HLChangeForbidden
  29. do: [ :ex | ]
  30. ! !
  31. !HLModel methodsFor: 'testing'!
  32. isBrowserModel
  33. ^ false
  34. !
  35. isReferencesModel
  36. ^ false
  37. !
  38. isToolModel
  39. ^ false
  40. ! !
  41. HLModel subclass: #HLToolModel
  42. instanceVariableNames: 'selectedClass selectedPackage selectedProtocol selectedSelector'
  43. package: 'Helios-Core'!
  44. !HLToolModel methodsFor: 'accessing'!
  45. allSelectors
  46. ^ self environment allSelectors
  47. !
  48. availableClassNames
  49. ^ self environment availableClassNames
  50. !
  51. availablePackageNames
  52. ^ self environment availablePackageNames
  53. !
  54. availablePackages
  55. ^ self environment availablePackageNames
  56. !
  57. availableProtocols
  58. ^ self environment availableProtocolsFor: self selectedClass
  59. !
  60. packages
  61. ^ self environment packages
  62. !
  63. selectedClass
  64. ^ selectedClass
  65. !
  66. selectedClass: aClass
  67. (self selectedClass = aClass and: [ aClass isNil ])
  68. ifTrue: [ ^ self ].
  69. self withChangesDo: [
  70. selectedClass = aClass ifTrue: [
  71. self selectedProtocol: nil ].
  72. aClass
  73. ifNil: [ selectedClass := nil ]
  74. ifNotNil: [
  75. self selectedPackage: aClass theNonMetaClass package.
  76. self showInstance
  77. ifTrue: [ selectedClass := aClass theNonMetaClass ]
  78. ifFalse: [ selectedClass := aClass theMetaClass ] ].
  79. self selectedProtocol: nil.
  80. self announcer announce: (HLClassSelected on: self selectedClass) ]
  81. !
  82. selectedMethod
  83. ^ self selectedClass ifNotNil: [
  84. self selectedClass methodDictionary
  85. at: selectedSelector
  86. ifAbsent: [ nil ] ]
  87. !
  88. selectedMethod: aCompiledMethod
  89. selectedSelector = aCompiledMethod ifTrue: [ ^ self ].
  90. self withChangesDo: [
  91. aCompiledMethod
  92. ifNil: [ selectedSelector := nil ]
  93. ifNotNil: [
  94. selectedClass := aCompiledMethod methodClass.
  95. selectedSelector := aCompiledMethod selector ].
  96. self announcer announce: (HLMethodSelected on: aCompiledMethod) ]
  97. !
  98. selectedPackage
  99. ^ selectedPackage
  100. !
  101. selectedPackage: aPackage
  102. selectedPackage = aPackage ifTrue: [ ^ self ].
  103. self withChangesDo: [
  104. selectedPackage := aPackage.
  105. self selectedClass: nil.
  106. self announcer announce: (HLPackageSelected on: aPackage) ]
  107. !
  108. selectedProtocol
  109. ^ selectedProtocol
  110. !
  111. selectedProtocol: aString
  112. selectedProtocol = aString ifTrue: [ ^ self ].
  113. self withChangesDo: [
  114. selectedProtocol := aString.
  115. self selectedMethod: nil.
  116. self announcer announce: (HLProtocolSelected on: aString) ]
  117. ! !
  118. !HLToolModel methodsFor: 'actions'!
  119. addInstVarNamed: aString
  120. self environment addInstVarNamed: aString to: self selectedClass.
  121. self announcer announce: (HLInstVarAdded new
  122. theClass: self selectedClass;
  123. variableName: aString;
  124. yourself)
  125. !
  126. save: aString
  127. self announcer announce: HLSourceCodeSaved new.
  128. (self shouldCompileClassDefinition: aString)
  129. ifTrue: [ self compileClassDefinition: aString ]
  130. ifFalse: [ self compileMethod: aString ]
  131. !
  132. saveSourceCode
  133. self announcer announce: HLSaveSourceCode new
  134. ! !
  135. !HLToolModel methodsFor: 'commands actions'!
  136. commitPackage
  137. self
  138. withHelperLabelled: 'Committing package ', self selectedPackage name, '...'
  139. do: [ self environment commitPackage: self selectedPackage ]
  140. !
  141. copyClassTo: aClassName
  142. self withChangesDo: [
  143. self environment
  144. copyClass: self selectedClass theNonMetaClass
  145. to: aClassName ]
  146. !
  147. moveClassToPackage: aPackageName
  148. self withChangesDo: [
  149. self environment
  150. moveClass: self selectedClass theNonMetaClass
  151. toPackage: aPackageName ]
  152. !
  153. moveMethodToClass: aClassName
  154. self withChangesDo: [
  155. self environment
  156. moveMethod: self selectedMethod
  157. toClass: aClassName ]
  158. !
  159. moveMethodToProtocol: aProtocol
  160. self withChangesDo: [
  161. self environment
  162. moveMethod: self selectedMethod
  163. toProtocol: aProtocol ]
  164. !
  165. openClassNamed: aString
  166. | class |
  167. self withChangesDo: [
  168. class := self environment classNamed: aString.
  169. self selectedPackage: class package.
  170. self selectedClass: class ]
  171. !
  172. removeClass
  173. self withChangesDo: [
  174. self manager
  175. confirm: 'Do you REALLY want to remove class ', self selectedClass name
  176. ifTrue: [ self environment removeClass: self selectedClass ] ]
  177. !
  178. removeMethod
  179. self withChangesDo: [
  180. self manager
  181. confirm: 'Do you REALLY want to remove method ', self selectedMethod methodClass name,' >> #', self selectedMethod selector
  182. ifTrue: [ self environment removeMethod: self selectedMethod ] ]
  183. !
  184. removeProtocol
  185. self withChangesDo: [
  186. self manager
  187. confirm: 'Do you REALLY want to remove protocol ', self selectedProtocol
  188. ifTrue: [ self environment
  189. removeProtocol: self selectedProtocol
  190. from: self selectedClass ] ]
  191. !
  192. renameClassTo: aClassName
  193. self withChangesDo: [
  194. self environment
  195. renameClass: self selectedClass theNonMetaClass
  196. to: aClassName ]
  197. !
  198. renameProtocolTo: aString
  199. self withChangesDo: [
  200. self environment
  201. renameProtocol: self selectedProtocol
  202. to: aString
  203. in: self selectedClass ]
  204. ! !
  205. !HLToolModel methodsFor: 'compiling'!
  206. compileClassComment: aString
  207. self environment
  208. compileClassComment: aString
  209. for: self selectedClass
  210. !
  211. compileClassDefinition: aString
  212. self environment compileClassDefinition: aString
  213. !
  214. compileMethod: aString
  215. | method |
  216. self withCompileErrorHandling: [
  217. method := self environment
  218. compileMethod: aString
  219. for: self selectedClass
  220. protocol: self compilationProtocol.
  221. self selectedMethod: method ]
  222. ! !
  223. !HLToolModel methodsFor: 'defaults'!
  224. allProtocol
  225. ^ '-- all --'
  226. !
  227. unclassifiedProtocol
  228. ^ 'as yet unclassified'
  229. ! !
  230. !HLToolModel methodsFor: 'error handling'!
  231. handleCompileError: anError
  232. self announcer announce: (HLCompileErrorRaised new
  233. error: anError;
  234. yourself)
  235. !
  236. handleParseError: anError
  237. | split line column messageToInsert |
  238. split := anError messageText tokenize: ' : '.
  239. messageToInsert := split second.
  240. "21 = 'Parse error on line ' size + 1"
  241. split := split first copyFrom: 21 to: split first size.
  242. split := split tokenize: ' column '.
  243. line := split first.
  244. column := split second.
  245. self announcer announce: (HLParseErrorRaised new
  246. line: line asNumber;
  247. column: column asNumber;
  248. message: messageToInsert;
  249. error: anError;
  250. yourself)
  251. !
  252. handleUnkownVariableError: anError
  253. self announcer announce: (HLUnknownVariableErrorRaised new
  254. error: anError;
  255. yourself)
  256. !
  257. withCompileErrorHandling: aBlock
  258. [
  259. [
  260. aBlock
  261. on: ParseError
  262. do: [:ex | self handleParseError: ex ]
  263. ]
  264. on: UnknownVariableError
  265. do: [ :ex | self handleUnkownVariableError: ex ]
  266. ]
  267. on: CompilerError
  268. do: [ :ex | self handleCompileError: ex ]
  269. ! !
  270. !HLToolModel methodsFor: 'private'!
  271. compilationProtocol
  272. | currentProtocol |
  273. currentProtocol := self selectedProtocol.
  274. currentProtocol ifNil: [ currentProtocol := self unclassifiedProtocol ].
  275. self selectedMethod ifNotNil: [ currentProtocol := self selectedMethod protocol ].
  276. ^ currentProtocol = self allProtocol
  277. ifTrue: [ self unclassifiedProtocol ]
  278. ifFalse: [ currentProtocol ]
  279. !
  280. withHelperLabelled: aString do: aBlock
  281. "TODO: doesn't belong here"
  282. (window jQuery: '#helper') remove.
  283. [ :html |
  284. html div
  285. id: 'helper';
  286. with: aString ] appendToJQuery: 'body' asJQuery.
  287. [
  288. aBlock value.
  289. (window jQuery: '#helper') remove
  290. ]
  291. valueWithTimeout: 10
  292. ! !
  293. !HLToolModel methodsFor: 'testing'!
  294. isToolModel
  295. ^ true
  296. !
  297. shouldCompileClassDefinition: aString
  298. ^ self selectedClass isNil or: [
  299. aString first asUppercase = aString first ]
  300. ! !
  301. !HLToolModel class methodsFor: 'actions'!
  302. on: anEnvironment
  303. ^ self new
  304. environment: anEnvironment;
  305. yourself
  306. ! !
  307. Widget subclass: #HLTab
  308. instanceVariableNames: 'widget label root'
  309. package: 'Helios-Core'!
  310. !HLTab methodsFor: 'accessing'!
  311. activate
  312. self manager activate: self
  313. !
  314. add
  315. self manager addTab: self
  316. !
  317. displayLabel
  318. ^ self label size > 20
  319. ifTrue: [ (self label first: 20), '...' ]
  320. ifFalse: [ self label ]
  321. !
  322. focus
  323. self widget canHaveFocus ifTrue: [
  324. self widget focus ]
  325. !
  326. label
  327. ^ label ifNil: [ '' ]
  328. !
  329. label: aString
  330. label := aString
  331. !
  332. manager
  333. ^ HLManager current
  334. !
  335. widget
  336. ^ widget
  337. !
  338. widget: aWidget
  339. widget := aWidget
  340. ! !
  341. !HLTab methodsFor: 'actions'!
  342. hide
  343. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  344. !
  345. registerBindings
  346. self widget registerBindings
  347. !
  348. remove
  349. root ifNotNil: [ root asJQuery remove ]
  350. !
  351. show
  352. root
  353. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  354. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  355. ! !
  356. !HLTab methodsFor: 'rendering'!
  357. renderOn: html
  358. root := html div
  359. class: 'tab';
  360. yourself.
  361. self renderTab
  362. !
  363. renderTab
  364. root contents: [ :html |
  365. html div
  366. class: 'amber_box';
  367. with: [ self widget renderOn: html ] ]
  368. ! !
  369. !HLTab methodsFor: 'testing'!
  370. isActive
  371. ^ self manager activeTab = self
  372. ! !
  373. !HLTab class methodsFor: 'instance creation'!
  374. on: aWidget labelled: aString
  375. ^ self new
  376. widget: aWidget;
  377. label: aString;
  378. yourself
  379. ! !
  380. Widget subclass: #HLWidget
  381. instanceVariableNames: 'wrapper'
  382. package: 'Helios-Core'!
  383. !HLWidget methodsFor: 'accessing'!
  384. manager
  385. ^ HLManager current
  386. !
  387. wrapper
  388. ^ wrapper
  389. ! !
  390. !HLWidget methodsFor: 'actions'!
  391. alert: aString
  392. window alert: aString
  393. !
  394. confirm: aString ifTrue: aBlock
  395. self manager confirm: aString ifTrue: aBlock
  396. !
  397. execute: aCommand
  398. HLManager current keyBinder
  399. activate;
  400. applyBinding: aCommand asBinding
  401. ! !
  402. !HLWidget methodsFor: 'keybindings'!
  403. registerBindings
  404. self registerBindingsOn: self manager keyBinder bindings
  405. !
  406. registerBindingsOn: aBindingGroup
  407. ! !
  408. !HLWidget methodsFor: 'rendering'!
  409. renderContentOn: html
  410. !
  411. renderOn: html
  412. wrapper := html div.
  413. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  414. ! !
  415. !HLWidget methodsFor: 'testing'!
  416. canHaveFocus
  417. ^ false
  418. ! !
  419. !HLWidget methodsFor: 'updating'!
  420. refresh
  421. self wrapper ifNil: [ ^ self ].
  422. self wrapper asJQuery empty.
  423. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  424. ! !
  425. !HLWidget class methodsFor: 'accessing'!
  426. openAsTab
  427. self canBeOpenAsTab ifFalse: [ ^ self ].
  428. HLManager current addTab: (HLTab on: self new labelled: self tabLabel)
  429. !
  430. tabLabel
  431. ^ 'Tab'
  432. !
  433. tabPriority
  434. ^ 500
  435. ! !
  436. !HLWidget class methodsFor: 'testing'!
  437. canBeOpenAsTab
  438. ^ false
  439. ! !
  440. HLWidget subclass: #HLConfirmation
  441. instanceVariableNames: 'confirmationString actionBlock cancelBlock'
  442. package: 'Helios-Core'!
  443. !HLConfirmation methodsFor: 'accessing'!
  444. actionBlock
  445. ^ actionBlock ifNil: [ [] ]
  446. !
  447. actionBlock: aBlock
  448. actionBlock := aBlock
  449. !
  450. cancelBlock
  451. ^ cancelBlock ifNil: [ [] ]
  452. !
  453. cancelBlock: aBlock
  454. cancelBlock := aBlock
  455. !
  456. confirmationString
  457. ^ confirmationString ifNil: [ 'Confirm' ]
  458. !
  459. confirmationString: aString
  460. confirmationString := aString
  461. ! !
  462. !HLConfirmation methodsFor: 'actions'!
  463. cancel
  464. self cancelBlock value.
  465. self remove
  466. !
  467. confirm
  468. self actionBlock value.
  469. self remove
  470. !
  471. remove
  472. (window jQuery: '.confirmation') removeClass: 'active'.
  473. [
  474. (window jQuery: '#overlay') remove.
  475. (window jQuery: '.confirmation') remove
  476. ] valueWithTimeout: 300
  477. ! !
  478. !HLConfirmation methodsFor: 'rendering'!
  479. renderContentOn: html
  480. | confirmButton |
  481. html div id: 'overlay'.
  482. html div
  483. class: 'confirmation';
  484. with: [
  485. html span with: self confirmationString.
  486. html div
  487. class: 'buttons';
  488. with: [
  489. html button
  490. class: 'button';
  491. with: 'Cancel';
  492. onClick: [ self cancel ].
  493. confirmButton := html button
  494. class: 'button default';
  495. with: 'Confirm';
  496. onClick: [ self confirm ] ] ].
  497. confirmButton asJQuery focus.
  498. (window jQuery: '.confirmation') addClass: 'active'.
  499. self setupKeyBindings
  500. !
  501. setupKeyBindings
  502. (window jQuery: '.confirmation') keyup: [ :e |
  503. e keyCode = 27 ifTrue: [ self cancel ] ]
  504. ! !
  505. HLWidget subclass: #HLDebugger
  506. instanceVariableNames: ''
  507. package: 'Helios-Core'!
  508. HLWidget subclass: #HLFocusableWidget
  509. instanceVariableNames: ''
  510. package: 'Helios-Core'!
  511. !HLFocusableWidget methodsFor: 'accessing'!
  512. focusClass
  513. ^ 'focused'
  514. ! !
  515. !HLFocusableWidget methodsFor: 'events'!
  516. blur
  517. self wrapper asJQuery blur
  518. !
  519. focus
  520. self wrapper asJQuery focus
  521. !
  522. hasFocus
  523. ^ self wrapper notNil and: [ self wrapper asJQuery is: ':focus' ]
  524. ! !
  525. !HLFocusableWidget methodsFor: 'rendering'!
  526. renderContentOn: html
  527. !
  528. renderOn: html
  529. self registerBindings.
  530. wrapper := html div
  531. class: 'hl_widget';
  532. yourself.
  533. wrapper with: [ self renderContentOn: html ].
  534. wrapper
  535. at: 'tabindex' put: '0';
  536. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  537. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  538. ! !
  539. !HLFocusableWidget methodsFor: 'testing'!
  540. canHaveFocus
  541. ^ true
  542. ! !
  543. HLFocusableWidget subclass: #HLListWidget
  544. instanceVariableNames: 'items selectedItem mapping'
  545. package: 'Helios-Core'!
  546. !HLListWidget methodsFor: 'accessing'!
  547. cssClassForItem: anObject
  548. ^ self selectedItem = anObject
  549. ifTrue: [ 'active' ]
  550. ifFalse: [ 'inactive' ]
  551. !
  552. iconForItem: anObject
  553. ^ ''
  554. !
  555. items
  556. ^ items ifNil: [ items := self defaultItems ]
  557. !
  558. items: aCollection
  559. items := aCollection
  560. !
  561. positionOf: aListItem
  562. <
  563. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  564. >
  565. !
  566. selectedItem
  567. ^ selectedItem
  568. !
  569. selectedItem: anObject
  570. selectedItem := anObject
  571. ! !
  572. !HLListWidget methodsFor: 'actions'!
  573. activateFirstListItem
  574. self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li.inactive') get: 0))
  575. !
  576. activateItem: anObject
  577. self activateListItem: (mapping
  578. at: anObject
  579. ifAbsent: [ ^ self ]) asJQuery
  580. !
  581. activateListItem: aListItem
  582. | item |
  583. (aListItem get: 0) ifNil: [ ^self ].
  584. aListItem parent children removeClass: 'active'.
  585. aListItem addClass: 'active'.
  586. self ensureVisible: aListItem.
  587. "Activate the corresponding item"
  588. item := (self items at: (aListItem attr: 'list-data') asNumber).
  589. self selectedItem == item ifFalse: [
  590. self selectItem: item ]
  591. !
  592. activateNextListItem
  593. self activateListItem: (window jQuery: '.focused .nav-pills .active') next.
  594. "select the first item if none is selected"
  595. (window jQuery: '.focused .nav-pills .active') get ifEmpty: [
  596. self activateFirstListItem ]
  597. !
  598. activatePreviousListItem
  599. self activateListItem: (window jQuery: '.focused .nav-pills .active') prev
  600. !
  601. ensureVisible: aListItem
  602. "Move the scrollbar to show the active element"
  603. | perent position |
  604. position := self positionOf: aListItem.
  605. parent := aListItem parent.
  606. aListItem position top < 0 ifTrue: [
  607. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  608. aListItem position top + aListItem height > parent height ifTrue: [
  609. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ]
  610. !
  611. focus
  612. super focus.
  613. self items isEmpty ifFalse: [
  614. self selectedItem ifNil: [ self activateFirstListItem ] ]
  615. !
  616. refresh
  617. super refresh.
  618. self ensureVisible: (mapping
  619. at: self selectedItem
  620. ifAbsent: [ ^ self ]) asJQuery
  621. !
  622. selectItem: anObject
  623. self selectedItem: anObject
  624. ! !
  625. !HLListWidget methodsFor: 'defaults'!
  626. defaultItems
  627. ^ #()
  628. ! !
  629. !HLListWidget methodsFor: 'events'!
  630. setupKeyBindings
  631. "TODO: refactor this!!"
  632. | active interval delay repeatInterval |
  633. active := false.
  634. repeatInterval := 70.
  635. self wrapper asJQuery unbind: 'keydown'.
  636. self wrapper asJQuery keydown: [ :e |
  637. (e which = 38 and: [ active = false ]) ifTrue: [
  638. active := true.
  639. self activatePreviousListItem.
  640. delay := [
  641. interval := [
  642. (self wrapper asJQuery hasClass: self focusClass)
  643. ifTrue: [
  644. self activatePreviousListItem ]
  645. ifFalse: [
  646. active := false.
  647. interval ifNotNil: [ interval clearInterval ].
  648. delay ifNotNil: [ delay clearTimeout] ] ]
  649. valueWithInterval: repeatInterval ]
  650. valueWithTimeout: 300 ].
  651. (e which = 40 and: [ active = false ]) ifTrue: [
  652. active := true.
  653. self activateNextListItem.
  654. delay := [
  655. interval := [
  656. (self wrapper asJQuery hasClass: self focusClass)
  657. ifTrue: [
  658. self activateNextListItem ]
  659. ifFalse: [
  660. active := false.
  661. interval ifNotNil: [ interval clearInterval ].
  662. delay ifNotNil: [ delay clearTimeout] ] ]
  663. valueWithInterval: repeatInterval ]
  664. valueWithTimeout: 300 ] ].
  665. self wrapper asJQuery keyup: [ :e |
  666. active ifTrue: [
  667. active := false.
  668. interval ifNotNil: [ interval clearInterval ].
  669. delay ifNotNil: [ delay clearTimeout] ] ]
  670. ! !
  671. !HLListWidget methodsFor: 'initialization'!
  672. initialize
  673. super initialize.
  674. mapping := Dictionary new.
  675. ! !
  676. !HLListWidget methodsFor: 'private'!
  677. registerMappingFrom: anObject to: aTag
  678. mapping at: anObject put: aTag
  679. ! !
  680. !HLListWidget methodsFor: 'rendering'!
  681. renderButtonsOn: html
  682. !
  683. renderContentOn: html
  684. html ul
  685. class: 'nav nav-pills nav-stacked';
  686. with: [ self renderListOn: html ].
  687. html div class: 'pane_actions form-actions'; with: [
  688. self renderButtonsOn: html ].
  689. self setupKeyBindings
  690. !
  691. renderItem: anObject on: html
  692. | li |
  693. li := html li.
  694. self registerMappingFrom: anObject to: li.
  695. li
  696. class: (self cssClassForItem: anObject);
  697. at: 'list-data' put: (self items indexOf: anObject) asString;
  698. with: [
  699. html a
  700. with: [
  701. (html tag: 'i') class: (self iconForItem: anObject).
  702. self renderItemLabel: anObject on: html ];
  703. onClick: [
  704. self activateListItem: li asJQuery ] ]
  705. !
  706. renderItemLabel: anObject on: html
  707. html with: anObject asString
  708. !
  709. renderListOn: html
  710. mapping := Dictionary new.
  711. self items do: [ :each |
  712. self renderItem: each on: html ]
  713. ! !
  714. HLListWidget subclass: #HLNavigationListWidget
  715. instanceVariableNames: 'previous next'
  716. package: 'Helios-Core'!
  717. !HLNavigationListWidget methodsFor: 'accessing'!
  718. next
  719. ^ next
  720. !
  721. next: aWidget
  722. next := aWidget.
  723. aWidget previous = self ifFalse: [ aWidget previous: self ]
  724. !
  725. previous
  726. ^ previous
  727. !
  728. previous: aWidget
  729. previous := aWidget.
  730. aWidget next = self ifFalse: [ aWidget next: self ]
  731. ! !
  732. !HLNavigationListWidget methodsFor: 'actions'!
  733. nextFocus
  734. self next ifNotNil: [ self next focus ]
  735. !
  736. previousFocus
  737. self previous ifNotNil: [ self previous focus ]
  738. ! !
  739. !HLNavigationListWidget methodsFor: 'events'!
  740. setupKeyBindings
  741. super setupKeyBindings.
  742. self wrapper asJQuery keydown: [ :e |
  743. e which = 39 ifTrue: [
  744. self nextFocus ].
  745. e which = 37 ifTrue: [
  746. self previousFocus ] ]
  747. ! !
  748. HLNavigationListWidget subclass: #HLToolListWidget
  749. instanceVariableNames: 'model'
  750. package: 'Helios-Core'!
  751. !HLToolListWidget methodsFor: 'accessing'!
  752. commandCategory
  753. ^ self label
  754. !
  755. label
  756. ^ 'List'
  757. !
  758. menuCommands
  759. "Answer a collection of commands to be put in the cog menu"
  760. ^ ((HLToolCommand concreteClasses
  761. select: [ :each | each isValidFor: self model ])
  762. collect: [ :each | each for: self model ])
  763. select: [ :each |
  764. each category = self commandCategory and: [
  765. each isAction and: [ each isActive ] ] ]
  766. !
  767. model
  768. ^ model
  769. !
  770. model: aBrowserModel
  771. model := aBrowserModel.
  772. self
  773. observeSystem;
  774. observeModel
  775. !
  776. selectedItem: anItem
  777. "Selection changed, update the cog menu"
  778. super selectedItem: anItem.
  779. self updateMenu
  780. ! !
  781. !HLToolListWidget methodsFor: 'actions'!
  782. activateListItem: anItem
  783. self model withChangesDo: [ super activateListItem: anItem ]
  784. !
  785. activateNextListItem
  786. self model withChangesDo: [ super activateNextListItem ]
  787. !
  788. activatePreviousListItem
  789. self model withChangesDo: [ super activatePreviousListItem ]
  790. !
  791. observeModel
  792. !
  793. observeSystem
  794. ! !
  795. !HLToolListWidget methodsFor: 'rendering'!
  796. renderContentOn: html
  797. self renderHeadOn: html.
  798. super renderContentOn: html
  799. !
  800. renderHeadOn: html
  801. html div
  802. class: 'list-label';
  803. with: [
  804. html with: self label.
  805. self renderMenuOn: html ]
  806. !
  807. renderMenuOn: html
  808. | commands |
  809. commands := self menuCommands.
  810. commands isEmpty ifTrue: [ ^ self ].
  811. html div
  812. class: 'btn-group cog';
  813. with: [
  814. html a
  815. class: 'btn dropdown-toggle';
  816. at: 'data-toggle' put: 'dropdown';
  817. with: [ (html tag: 'i') class: 'icon-cog' ].
  818. html ul
  819. class: 'dropdown-menu pull-right';
  820. with: [
  821. self menuCommands do: [ :each |
  822. html li with: [ html a
  823. with: each menuLabel;
  824. onClick: [ self execute: each ] ] ] ] ]
  825. ! !
  826. !HLToolListWidget methodsFor: 'updating'!
  827. updateMenu
  828. (self wrapper asJQuery find: '.cog') remove.
  829. [ :html | self renderMenuOn: html ]
  830. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  831. ! !
  832. !HLToolListWidget class methodsFor: 'instance creation'!
  833. on: aModel
  834. ^ self new
  835. model: aModel;
  836. yourself
  837. ! !
  838. HLWidget subclass: #HLManager
  839. instanceVariableNames: 'tabs activeTab keyBinder environment history'
  840. package: 'Helios-Core'!
  841. !HLManager methodsFor: 'accessing'!
  842. activeTab
  843. ^ activeTab
  844. !
  845. environment
  846. "The default environment used by all Helios objects"
  847. ^ environment ifNil: [ environment := self defaultEnvironment ]
  848. !
  849. environment: anEnvironment
  850. environment := anEnvironment
  851. !
  852. history
  853. ^ history ifNil: [ history := OrderedCollection new ]
  854. !
  855. history: aCollection
  856. history := aCollection
  857. !
  858. keyBinder
  859. ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
  860. !
  861. tabs
  862. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  863. ! !
  864. !HLManager methodsFor: 'actions'!
  865. activate: aTab
  866. self keyBinder flushBindings.
  867. aTab registerBindings.
  868. activeTab := aTab.
  869. self
  870. refresh;
  871. addToHistory: aTab;
  872. show: aTab
  873. !
  874. addTab: aTab
  875. self tabs add: aTab.
  876. self activate: aTab
  877. !
  878. addToHistory: aTab
  879. self removeFromHistory: aTab.
  880. self history add: aTab
  881. !
  882. confirm: aString ifFalse: aBlock
  883. (HLConfirmation new
  884. confirmationString: aString;
  885. cancelBlock: aBlock;
  886. yourself)
  887. appendToJQuery: 'body' asJQuery
  888. !
  889. confirm: aString ifTrue: aBlock
  890. (HLConfirmation new
  891. confirmationString: aString;
  892. actionBlock: aBlock;
  893. yourself)
  894. appendToJQuery: 'body' asJQuery
  895. !
  896. removeActiveTab
  897. self removeTab: self activeTab
  898. !
  899. removeFromHistory: aTab
  900. self history: (self history reject: [ :each | each == aTab ])
  901. !
  902. removeTab: aTab
  903. (self tabs includes: aTab) ifFalse: [ ^ self ].
  904. self removeFromHistory: aTab.
  905. self tabs remove: aTab.
  906. self keyBinder flushBindings.
  907. aTab remove.
  908. self refresh.
  909. self history ifNotEmpty: [
  910. self history last activate ]
  911. ! !
  912. !HLManager methodsFor: 'defaults'!
  913. defaultEnvironment
  914. "If helios is loaded from within a frame, answer the parent window environment"
  915. window parent ifNil: [ ^ Environment new ].
  916. ^ ((window parent at: 'smalltalk')
  917. at: 'Environment') new
  918. ! !
  919. !HLManager methodsFor: 'initialization'!
  920. initialize
  921. super initialize.
  922. self keyBinder setupEvents
  923. ! !
  924. !HLManager methodsFor: 'rendering'!
  925. refresh
  926. (window jQuery: '.navbar') remove.
  927. self appendToJQuery: 'body' asJQuery
  928. !
  929. renderAddOn: html
  930. html li
  931. class: 'dropdown';
  932. with: [
  933. html a
  934. class: 'dropdown-toggle';
  935. at: 'data-toggle' put: 'dropdown';
  936. with: [
  937. html with: 'Open...'.
  938. (html tag: 'b') class: 'caret' ].
  939. html ul
  940. class: 'dropdown-menu';
  941. with: [
  942. ((HLWidget withAllSubclasses
  943. select: [ :each | each canBeOpenAsTab ])
  944. sorted: [ :a :b | a tabPriority < b tabPriority ])
  945. do: [ :each |
  946. html li with: [
  947. html a
  948. with: each tabLabel;
  949. onClick: [ each openAsTab ] ] ] ] ]
  950. !
  951. renderContentOn: html
  952. html div
  953. class: 'navbar navbar-fixed-top';
  954. with: [ html div
  955. class: 'navbar-inner';
  956. with: [ self renderTabsOn: html ] ]
  957. !
  958. renderTabsOn: html
  959. html ul
  960. class: 'nav';
  961. with: [
  962. self tabs do: [ :each |
  963. html li
  964. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  965. with: [
  966. html a
  967. with: [
  968. ((html tag: 'i') class: 'icon-remove')
  969. onClick: [ self removeTab: each ].
  970. html with: each displayLabel ];
  971. onClick: [ each activate ] ] ].
  972. self renderAddOn: html ]
  973. !
  974. show: aTab
  975. self tabs do: [ :each | each hide ].
  976. aTab show; focus
  977. ! !
  978. HLManager class instanceVariableNames: 'current'!
  979. !HLManager class methodsFor: 'accessing'!
  980. current
  981. ^ current ifNil: [ current := self basicNew initialize ]
  982. ! !
  983. !HLManager class methodsFor: 'initialization'!
  984. initialize
  985. self current appendToJQuery: 'body' asJQuery
  986. ! !
  987. !HLManager class methodsFor: 'instance creation'!
  988. new
  989. "Use current instead"
  990. self shouldNotImplement
  991. ! !
  992. HLWidget subclass: #HLSUnit
  993. instanceVariableNames: ''
  994. package: 'Helios-Core'!
  995. !HLSUnit class methodsFor: 'accessing'!
  996. tabLabel
  997. ^ 'SUnit'
  998. !
  999. tabPriority
  1000. ^ 1000
  1001. ! !
  1002. !HLSUnit class methodsFor: 'testing'!
  1003. canBeOpenAsTab
  1004. ^ true
  1005. ! !
  1006. HLWidget subclass: #HLTranscript
  1007. instanceVariableNames: ''
  1008. package: 'Helios-Core'!
  1009. !HLTranscript class methodsFor: 'accessing'!
  1010. tabLabel
  1011. ^ 'Transcript'
  1012. !
  1013. tabPriority
  1014. ^ 600
  1015. ! !
  1016. !HLTranscript class methodsFor: 'testing'!
  1017. canBeOpenAsTab
  1018. ^ true
  1019. ! !