1
0

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 first asUppercase = aString first ]
  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. displayLabel
  333. ^ self label size > 20
  334. ifTrue: [ (self label first: 20), '...' ]
  335. ifFalse: [ self label ]
  336. !
  337. focus
  338. self widget canHaveFocus ifTrue: [
  339. self widget focus ]
  340. !
  341. label
  342. ^ label ifNil: [ '' ]
  343. !
  344. label: aString
  345. label := aString
  346. !
  347. manager
  348. ^ HLManager current
  349. !
  350. widget
  351. ^ widget
  352. !
  353. widget: aWidget
  354. widget := aWidget
  355. ! !
  356. !HLTab methodsFor: 'actions'!
  357. hide
  358. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  359. !
  360. registerBindings
  361. self widget registerBindings
  362. !
  363. remove
  364. self widget unregister.
  365. root ifNotNil: [ root asJQuery remove ]
  366. !
  367. show
  368. root
  369. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  370. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  371. ! !
  372. !HLTab methodsFor: 'rendering'!
  373. renderOn: html
  374. root := html div
  375. class: 'tab';
  376. yourself.
  377. self renderTab
  378. !
  379. renderTab
  380. root contents: [ :html |
  381. html div
  382. class: 'amber_box';
  383. with: [ self widget renderOn: html ] ]
  384. ! !
  385. !HLTab methodsFor: 'testing'!
  386. isActive
  387. ^ self manager activeTab = self
  388. ! !
  389. !HLTab class methodsFor: 'instance creation'!
  390. on: aWidget labelled: aString
  391. ^ self new
  392. widget: aWidget;
  393. label: aString;
  394. yourself
  395. ! !
  396. Widget subclass: #HLWidget
  397. instanceVariableNames: 'wrapper'
  398. package: 'Helios-Core'!
  399. !HLWidget commentStamp!
  400. I am the abstract superclass of all Helios widgets.
  401. I provide common methods, additional behavior to widgets useful for Helios, like dialog creation, command execution and tab creation.!
  402. !HLWidget methodsFor: 'accessing'!
  403. manager
  404. ^ HLManager current
  405. !
  406. wrapper
  407. ^ wrapper
  408. ! !
  409. !HLWidget methodsFor: 'actions'!
  410. alert: aString
  411. window alert: aString
  412. !
  413. confirm: aString ifTrue: aBlock
  414. self manager confirm: aString ifTrue: aBlock
  415. !
  416. execute: aCommand
  417. HLManager current keyBinder
  418. activate;
  419. applyBinding: aCommand asBinding
  420. !
  421. request: aString do: aBlock
  422. self manager request: aString do: aBlock
  423. !
  424. request: aString value: valueString do: aBlock
  425. self manager
  426. request: aString
  427. value: valueString
  428. do: aBlock
  429. !
  430. unregister
  431. "This method is called whenever the receiver is closed (as a tab).
  432. Widgets subscribing to announcements should unregister there"
  433. ! !
  434. !HLWidget methodsFor: 'keybindings'!
  435. registerBindings
  436. self registerBindingsOn: self manager keyBinder bindings
  437. !
  438. registerBindingsOn: aBindingGroup
  439. ! !
  440. !HLWidget methodsFor: 'rendering'!
  441. renderContentOn: html
  442. !
  443. renderOn: html
  444. wrapper := html div.
  445. [ :renderer | self renderContentOn: renderer ] appendToJQuery: wrapper asJQuery
  446. ! !
  447. !HLWidget methodsFor: 'testing'!
  448. canHaveFocus
  449. ^ false
  450. ! !
  451. !HLWidget methodsFor: 'updating'!
  452. refresh
  453. self wrapper ifNil: [ ^ self ].
  454. self wrapper asJQuery empty.
  455. [ :html | self renderContentOn: html ] appendToJQuery: self wrapper asJQuery
  456. ! !
  457. !HLWidget class methodsFor: 'accessing'!
  458. openAsTab
  459. self canBeOpenAsTab ifFalse: [ ^ self ].
  460. HLManager current addTab: (HLTab on: self new labelled: self tabLabel)
  461. !
  462. tabLabel
  463. ^ 'Tab'
  464. !
  465. tabPriority
  466. ^ 500
  467. ! !
  468. !HLWidget class methodsFor: 'testing'!
  469. canBeOpenAsTab
  470. ^ false
  471. ! !
  472. HLWidget subclass: #HLConfirmation
  473. instanceVariableNames: 'confirmationString actionBlock cancelBlock'
  474. package: 'Helios-Core'!
  475. !HLConfirmation methodsFor: 'accessing'!
  476. actionBlock
  477. ^ actionBlock ifNil: [ [] ]
  478. !
  479. actionBlock: aBlock
  480. actionBlock := aBlock
  481. !
  482. cancelBlock
  483. ^ cancelBlock ifNil: [ [] ]
  484. !
  485. cancelBlock: aBlock
  486. cancelBlock := aBlock
  487. !
  488. confirmationString
  489. ^ confirmationString ifNil: [ 'Confirm' ]
  490. !
  491. confirmationString: aString
  492. confirmationString := aString
  493. !
  494. cssClass
  495. ^ ''
  496. ! !
  497. !HLConfirmation methodsFor: 'actions'!
  498. cancel
  499. self cancelBlock value.
  500. self remove
  501. !
  502. confirm
  503. self actionBlock value.
  504. self remove
  505. !
  506. remove
  507. (window jQuery: '.dialog') removeClass: 'active'.
  508. [
  509. (window jQuery: '#overlay') remove.
  510. (window jQuery: '.dialog') remove
  511. ] valueWithTimeout: 300
  512. ! !
  513. !HLConfirmation methodsFor: 'rendering'!
  514. renderButtonsOn: html
  515. | confirmButton |
  516. html div
  517. class: 'buttons';
  518. with: [
  519. html button
  520. class: 'button';
  521. with: 'Cancel';
  522. onClick: [ self cancel ].
  523. confirmButton := html button
  524. class: 'button default';
  525. with: 'Confirm';
  526. onClick: [ self confirm ] ].
  527. confirmButton asJQuery focus
  528. !
  529. renderContentOn: html
  530. | confirmButton |
  531. html div id: 'overlay'.
  532. html div
  533. class: 'dialog ', self cssClass;
  534. with: [
  535. self
  536. renderMainOn: html;
  537. renderButtonsOn: html ].
  538. (window jQuery: '.dialog') addClass: 'active'.
  539. self setupKeyBindings
  540. !
  541. renderMainOn: html
  542. html span with: self confirmationString
  543. !
  544. setupKeyBindings
  545. (window jQuery: '.dialog') keyup: [ :e |
  546. e keyCode = 27 ifTrue: [ self cancel ] ]
  547. ! !
  548. HLConfirmation subclass: #HLRequest
  549. instanceVariableNames: 'input value'
  550. package: 'Helios-Core'!
  551. !HLRequest methodsFor: 'accessing'!
  552. cssClass
  553. ^ 'large'
  554. !
  555. value
  556. ^ value ifNil: [ '' ]
  557. !
  558. value: aString
  559. value := aString
  560. ! !
  561. !HLRequest methodsFor: 'actions'!
  562. confirm
  563. self actionBlock value: input asJQuery val.
  564. self remove
  565. ! !
  566. !HLRequest methodsFor: 'rendering'!
  567. renderMainOn: html
  568. super renderMainOn: html.
  569. input := html textarea.
  570. input asJQuery val: self value
  571. ! !
  572. HLWidget subclass: #HLDebugger
  573. instanceVariableNames: ''
  574. package: 'Helios-Core'!
  575. HLWidget subclass: #HLFocusableWidget
  576. instanceVariableNames: ''
  577. package: 'Helios-Core'!
  578. !HLFocusableWidget methodsFor: 'accessing'!
  579. focusClass
  580. ^ 'focused'
  581. ! !
  582. !HLFocusableWidget methodsFor: 'events'!
  583. blur
  584. self wrapper asJQuery blur
  585. !
  586. focus
  587. self wrapper asJQuery focus
  588. !
  589. hasFocus
  590. ^ self wrapper notNil and: [ self wrapper asJQuery is: ':focus' ]
  591. ! !
  592. !HLFocusableWidget methodsFor: 'rendering'!
  593. renderContentOn: html
  594. !
  595. renderOn: html
  596. self registerBindings.
  597. wrapper := html div
  598. class: 'hl_widget';
  599. yourself.
  600. wrapper with: [ self renderContentOn: html ].
  601. wrapper
  602. at: 'tabindex' put: '0';
  603. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  604. onFocus: [ self wrapper asJQuery addClass: self focusClass ]
  605. ! !
  606. !HLFocusableWidget methodsFor: 'testing'!
  607. canHaveFocus
  608. ^ true
  609. ! !
  610. HLFocusableWidget subclass: #HLListWidget
  611. instanceVariableNames: 'items selectedItem mapping'
  612. package: 'Helios-Core'!
  613. !HLListWidget methodsFor: 'accessing'!
  614. cssClassForItem: anObject
  615. ^ self selectedItem = anObject
  616. ifTrue: [ 'active' ]
  617. ifFalse: [ 'inactive' ]
  618. !
  619. iconForItem: anObject
  620. ^ ''
  621. !
  622. items
  623. ^ items ifNil: [ items := self defaultItems ]
  624. !
  625. items: aCollection
  626. items := aCollection
  627. !
  628. positionOf: aListItem
  629. <
  630. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  631. >
  632. !
  633. selectedItem
  634. ^ selectedItem
  635. !
  636. selectedItem: anObject
  637. selectedItem := anObject
  638. ! !
  639. !HLListWidget methodsFor: 'actions'!
  640. activateFirstListItem
  641. self activateListItem: (window jQuery: ((wrapper asJQuery find: 'li.inactive') get: 0))
  642. !
  643. activateItem: anObject
  644. self activateListItem: (mapping
  645. at: anObject
  646. ifAbsent: [ ^ self ]) asJQuery
  647. !
  648. activateListItem: aListItem
  649. | item |
  650. (aListItem get: 0) ifNil: [ ^self ].
  651. aListItem parent children removeClass: 'active'.
  652. aListItem addClass: 'active'.
  653. self ensureVisible: aListItem.
  654. "Activate the corresponding item"
  655. item := (self items at: (aListItem attr: 'list-data') asNumber).
  656. self selectedItem == item ifFalse: [
  657. self selectItem: item ]
  658. !
  659. activateNextListItem
  660. self activateListItem: (window jQuery: '.focused .nav-pills .active') next.
  661. "select the first item if none is selected"
  662. (window jQuery: '.focused .nav-pills .active') get ifEmpty: [
  663. self activateFirstListItem ]
  664. !
  665. activatePreviousListItem
  666. self activateListItem: (window jQuery: '.focused .nav-pills .active') prev
  667. !
  668. ensureVisible: aListItem
  669. "Move the scrollbar to show the active element"
  670. | perent position |
  671. position := self positionOf: aListItem.
  672. parent := aListItem parent.
  673. aListItem position top < 0 ifTrue: [
  674. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  675. aListItem position top + aListItem height > parent height ifTrue: [
  676. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ]
  677. !
  678. focus
  679. super focus.
  680. self items isEmpty ifFalse: [
  681. self selectedItem ifNil: [ self activateFirstListItem ] ]
  682. !
  683. refresh
  684. super refresh.
  685. self ensureVisible: (mapping
  686. at: self selectedItem
  687. ifAbsent: [ ^ self ]) asJQuery
  688. !
  689. selectItem: anObject
  690. self selectedItem: anObject
  691. ! !
  692. !HLListWidget methodsFor: 'defaults'!
  693. defaultItems
  694. ^ #()
  695. ! !
  696. !HLListWidget methodsFor: 'events'!
  697. setupKeyBindings
  698. "TODO: refactor this!!"
  699. | active interval delay repeatInterval |
  700. active := false.
  701. repeatInterval := 70.
  702. self wrapper asJQuery unbind: 'keydown'.
  703. self wrapper asJQuery keydown: [ :e |
  704. (e which = 38 and: [ active = false ]) ifTrue: [
  705. active := true.
  706. self activatePreviousListItem.
  707. delay := [
  708. interval := [
  709. (self wrapper asJQuery hasClass: self focusClass)
  710. ifTrue: [
  711. self activatePreviousListItem ]
  712. ifFalse: [
  713. active := false.
  714. interval ifNotNil: [ interval clearInterval ].
  715. delay ifNotNil: [ delay clearTimeout] ] ]
  716. valueWithInterval: repeatInterval ]
  717. valueWithTimeout: 300 ].
  718. (e which = 40 and: [ active = false ]) ifTrue: [
  719. active := true.
  720. self activateNextListItem.
  721. delay := [
  722. interval := [
  723. (self wrapper asJQuery hasClass: self focusClass)
  724. ifTrue: [
  725. self activateNextListItem ]
  726. ifFalse: [
  727. active := false.
  728. interval ifNotNil: [ interval clearInterval ].
  729. delay ifNotNil: [ delay clearTimeout] ] ]
  730. valueWithInterval: repeatInterval ]
  731. valueWithTimeout: 300 ] ].
  732. self wrapper asJQuery keyup: [ :e |
  733. active ifTrue: [
  734. active := false.
  735. interval ifNotNil: [ interval clearInterval ].
  736. delay ifNotNil: [ delay clearTimeout] ] ]
  737. ! !
  738. !HLListWidget methodsFor: 'initialization'!
  739. initialize
  740. super initialize.
  741. mapping := Dictionary new.
  742. ! !
  743. !HLListWidget methodsFor: 'private'!
  744. registerMappingFrom: anObject to: aTag
  745. mapping at: anObject put: aTag
  746. ! !
  747. !HLListWidget methodsFor: 'rendering'!
  748. renderButtonsOn: html
  749. !
  750. renderContentOn: html
  751. html ul
  752. class: 'nav nav-pills nav-stacked';
  753. with: [ self renderListOn: html ].
  754. html div class: 'pane_actions form-actions'; with: [
  755. self renderButtonsOn: html ].
  756. self setupKeyBindings
  757. !
  758. renderItem: anObject on: html
  759. | li |
  760. li := html li.
  761. self registerMappingFrom: anObject to: li.
  762. li
  763. class: (self cssClassForItem: anObject);
  764. at: 'list-data' put: (self items indexOf: anObject) asString;
  765. with: [
  766. html a
  767. with: [
  768. (html tag: 'i') class: (self iconForItem: anObject).
  769. self renderItemLabel: anObject on: html ];
  770. onClick: [
  771. self activateListItem: li asJQuery ] ]
  772. !
  773. renderItemLabel: anObject on: html
  774. html with: anObject asString
  775. !
  776. renderListOn: html
  777. mapping := Dictionary new.
  778. self items do: [ :each |
  779. self renderItem: each on: html ]
  780. ! !
  781. HLListWidget subclass: #HLNavigationListWidget
  782. instanceVariableNames: 'previous next'
  783. package: 'Helios-Core'!
  784. !HLNavigationListWidget methodsFor: 'accessing'!
  785. next
  786. ^ next
  787. !
  788. next: aWidget
  789. next := aWidget.
  790. aWidget previous = self ifFalse: [ aWidget previous: self ]
  791. !
  792. previous
  793. ^ previous
  794. !
  795. previous: aWidget
  796. previous := aWidget.
  797. aWidget next = self ifFalse: [ aWidget next: self ]
  798. ! !
  799. !HLNavigationListWidget methodsFor: 'actions'!
  800. nextFocus
  801. self next ifNotNil: [ self next focus ]
  802. !
  803. previousFocus
  804. self previous ifNotNil: [ self previous focus ]
  805. ! !
  806. !HLNavigationListWidget methodsFor: 'events'!
  807. setupKeyBindings
  808. super setupKeyBindings.
  809. self wrapper asJQuery keydown: [ :e |
  810. e which = 39 ifTrue: [
  811. self nextFocus ].
  812. e which = 37 ifTrue: [
  813. self previousFocus ] ]
  814. ! !
  815. HLNavigationListWidget subclass: #HLToolListWidget
  816. instanceVariableNames: 'model'
  817. package: 'Helios-Core'!
  818. !HLToolListWidget methodsFor: 'accessing'!
  819. commandCategory
  820. ^ self label
  821. !
  822. label
  823. ^ 'List'
  824. !
  825. menuCommands
  826. "Answer a collection of commands to be put in the cog menu"
  827. ^ ((HLToolCommand concreteClasses
  828. select: [ :each | each isValidFor: self model ])
  829. collect: [ :each | each for: self model ])
  830. select: [ :each |
  831. each category = self commandCategory and: [
  832. each isAction and: [ each isActive ] ] ]
  833. !
  834. model
  835. ^ model
  836. !
  837. model: aBrowserModel
  838. model := aBrowserModel.
  839. self
  840. observeSystem;
  841. observeModel
  842. !
  843. selectedItem: anItem
  844. "Selection changed, update the cog menu"
  845. super selectedItem: anItem.
  846. self updateMenu
  847. ! !
  848. !HLToolListWidget methodsFor: 'actions'!
  849. activateListItem: anItem
  850. self model withChangesDo: [ super activateListItem: anItem ]
  851. !
  852. activateNextListItem
  853. self model withChangesDo: [ super activateNextListItem ]
  854. !
  855. activatePreviousListItem
  856. self model withChangesDo: [ super activatePreviousListItem ]
  857. !
  858. observeModel
  859. !
  860. observeSystem
  861. !
  862. unregister
  863. super unregister.
  864. self model announcer unsubscribe: self.
  865. self model systemAnnouncer unsubscribe: self
  866. ! !
  867. !HLToolListWidget methodsFor: 'rendering'!
  868. renderContentOn: html
  869. self renderHeadOn: html.
  870. super renderContentOn: html
  871. !
  872. renderHeadOn: html
  873. html div
  874. class: 'list-label';
  875. with: [
  876. html with: self label.
  877. self renderMenuOn: html ]
  878. !
  879. renderMenuOn: html
  880. | commands |
  881. commands := self menuCommands.
  882. commands isEmpty ifTrue: [ ^ self ].
  883. html div
  884. class: 'btn-group cog';
  885. with: [
  886. html a
  887. class: 'btn dropdown-toggle';
  888. at: 'data-toggle' put: 'dropdown';
  889. with: [ (html tag: 'i') class: 'icon-cog' ].
  890. html ul
  891. class: 'dropdown-menu pull-right';
  892. with: [
  893. self menuCommands do: [ :each |
  894. html li with: [ html a
  895. with: each menuLabel;
  896. onClick: [ self execute: each ] ] ] ] ]
  897. ! !
  898. !HLToolListWidget methodsFor: 'updating'!
  899. updateMenu
  900. (self wrapper asJQuery find: '.cog') remove.
  901. [ :html | self renderMenuOn: html ]
  902. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  903. ! !
  904. !HLToolListWidget class methodsFor: 'instance creation'!
  905. on: aModel
  906. ^ self new
  907. model: aModel;
  908. yourself
  909. ! !
  910. HLWidget subclass: #HLManager
  911. instanceVariableNames: 'tabs activeTab keyBinder environment history'
  912. package: 'Helios-Core'!
  913. !HLManager methodsFor: 'accessing'!
  914. activeTab
  915. ^ activeTab
  916. !
  917. environment
  918. "The default environment used by all Helios objects"
  919. ^ environment ifNil: [ environment := self defaultEnvironment ]
  920. !
  921. environment: anEnvironment
  922. environment := anEnvironment
  923. !
  924. history
  925. ^ history ifNil: [ history := OrderedCollection new ]
  926. !
  927. history: aCollection
  928. history := aCollection
  929. !
  930. keyBinder
  931. ^ keyBinder ifNil: [ keyBinder := HLKeyBinder new ]
  932. !
  933. tabs
  934. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  935. ! !
  936. !HLManager methodsFor: 'actions'!
  937. activate: aTab
  938. self keyBinder flushBindings.
  939. aTab registerBindings.
  940. activeTab := aTab.
  941. self
  942. refresh;
  943. addToHistory: aTab;
  944. show: aTab
  945. !
  946. addTab: aTab
  947. self tabs add: aTab.
  948. self activate: aTab
  949. !
  950. addToHistory: aTab
  951. self removeFromHistory: aTab.
  952. self history add: aTab
  953. !
  954. confirm: aString ifFalse: aBlock
  955. (HLConfirmation new
  956. confirmationString: aString;
  957. cancelBlock: aBlock;
  958. yourself)
  959. appendToJQuery: 'body' asJQuery
  960. !
  961. confirm: aString ifTrue: aBlock
  962. (HLConfirmation new
  963. confirmationString: aString;
  964. actionBlock: aBlock;
  965. yourself)
  966. appendToJQuery: 'body' asJQuery
  967. !
  968. removeActiveTab
  969. self removeTab: self activeTab
  970. !
  971. removeFromHistory: aTab
  972. self history: (self history reject: [ :each | each == aTab ])
  973. !
  974. removeTab: aTab
  975. (self tabs includes: aTab) ifFalse: [ ^ self ].
  976. self removeFromHistory: aTab.
  977. self tabs remove: aTab.
  978. self keyBinder flushBindings.
  979. aTab remove.
  980. self refresh.
  981. self history ifNotEmpty: [
  982. self history last activate ]
  983. !
  984. request: aString do: aBlock
  985. self
  986. request: aString
  987. value: ''
  988. do: aBlock
  989. !
  990. request: aString value: valueString do: aBlock
  991. (HLRequest new
  992. confirmationString: aString;
  993. actionBlock: aBlock;
  994. value: valueString;
  995. yourself)
  996. appendToJQuery: 'body' asJQuery
  997. ! !
  998. !HLManager methodsFor: 'defaults'!
  999. defaultEnvironment
  1000. "If helios is loaded from within a frame, answer the parent window environment"
  1001. window parent ifNil: [ ^ Environment new ].
  1002. ^ ((window parent at: 'smalltalk')
  1003. at: 'Environment') new
  1004. ! !
  1005. !HLManager methodsFor: 'initialization'!
  1006. initialize
  1007. super initialize.
  1008. self keyBinder setupEvents
  1009. ! !
  1010. !HLManager methodsFor: 'rendering'!
  1011. refresh
  1012. (window jQuery: '.navbar') remove.
  1013. self appendToJQuery: 'body' asJQuery
  1014. !
  1015. renderAddOn: html
  1016. html li
  1017. class: 'dropdown';
  1018. with: [
  1019. html a
  1020. class: 'dropdown-toggle';
  1021. at: 'data-toggle' put: 'dropdown';
  1022. with: [
  1023. html with: 'Open...'.
  1024. (html tag: 'b') class: 'caret' ].
  1025. html ul
  1026. class: 'dropdown-menu';
  1027. with: [
  1028. ((HLWidget withAllSubclasses
  1029. select: [ :each | each canBeOpenAsTab ])
  1030. sorted: [ :a :b | a tabPriority < b tabPriority ])
  1031. do: [ :each |
  1032. html li with: [
  1033. html a
  1034. with: each tabLabel;
  1035. onClick: [ each openAsTab ] ] ] ] ]
  1036. !
  1037. renderContentOn: html
  1038. html div
  1039. class: 'navbar navbar-fixed-top';
  1040. with: [ html div
  1041. class: 'navbar-inner';
  1042. with: [ self renderTabsOn: html ] ]
  1043. !
  1044. renderTabsOn: html
  1045. html ul
  1046. class: 'nav';
  1047. with: [
  1048. self tabs do: [ :each |
  1049. html li
  1050. class: (each isActive ifTrue: [ 'active' ] ifFalse: [ 'inactive' ]);
  1051. with: [
  1052. html a
  1053. with: [
  1054. ((html tag: 'i') class: 'icon-remove')
  1055. onClick: [ self removeTab: each ].
  1056. html with: each displayLabel ];
  1057. onClick: [ each activate ] ] ].
  1058. self renderAddOn: html ]
  1059. !
  1060. show: aTab
  1061. self tabs do: [ :each | each hide ].
  1062. aTab show; focus
  1063. ! !
  1064. HLManager class instanceVariableNames: 'current'!
  1065. !HLManager class methodsFor: 'accessing'!
  1066. current
  1067. ^ current ifNil: [ current := self basicNew initialize ]
  1068. ! !
  1069. !HLManager class methodsFor: 'initialization'!
  1070. initialize
  1071. self current appendToJQuery: 'body' asJQuery
  1072. ! !
  1073. !HLManager class methodsFor: 'instance creation'!
  1074. new
  1075. "Use current instead"
  1076. self shouldNotImplement
  1077. ! !
  1078. HLWidget subclass: #HLSUnit
  1079. instanceVariableNames: ''
  1080. package: 'Helios-Core'!
  1081. !HLSUnit class methodsFor: 'accessing'!
  1082. tabLabel
  1083. ^ 'SUnit'
  1084. !
  1085. tabPriority
  1086. ^ 1000
  1087. ! !
  1088. !HLSUnit class methodsFor: 'testing'!
  1089. canBeOpenAsTab
  1090. ^ true
  1091. ! !
  1092. HLWidget subclass: #HLTranscript
  1093. instanceVariableNames: ''
  1094. package: 'Helios-Core'!
  1095. !HLTranscript class methodsFor: 'accessing'!
  1096. tabLabel
  1097. ^ 'Transcript'
  1098. !
  1099. tabPriority
  1100. ^ 600
  1101. ! !
  1102. !HLTranscript class methodsFor: 'testing'!
  1103. canBeOpenAsTab
  1104. ^ true
  1105. ! !