Helios-Core.st 28 KB

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