Helios-Core.st 46 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429
  1. Smalltalk createPackage: 'Helios-Core'!
  2. Object subclass: #HLModel
  3. slots: {#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. yourself).
  33. aBlock value.
  34. ]
  35. on: HLChangeForbidden
  36. do: [ :ex | ]
  37. ! !
  38. !HLModel methodsFor: 'testing'!
  39. isBrowserModel
  40. ^ false
  41. !
  42. isReferencesModel
  43. ^ false
  44. !
  45. isToolModel
  46. ^ false
  47. ! !
  48. HLModel subclass: #HLFinder
  49. slots: {}
  50. package: 'Helios-Core'!
  51. !HLFinder commentStamp!
  52. I am the `Finder` service handler of Helios.
  53. Finding a class will open a new class browser, while finding a method will open a references browser.!
  54. !HLFinder methodsFor: 'finding'!
  55. findClass: aClass
  56. HLBrowser openAsTab openClassNamed: aClass name
  57. !
  58. findMethod: aCompiledMethod
  59. HLBrowser openAsTab openMethod: aCompiledMethod
  60. !
  61. findString: aString
  62. | foundClass |
  63. foundClass := self environment classes
  64. detect: [ :each | each name = aString ]
  65. ifNone: [ nil ].
  66. foundClass
  67. ifNil: [ HLReferences openAsTab search: aString ]
  68. ifNotNil: [ self findClass: foundClass ]
  69. ! !
  70. HLModel subclass: #HLToolModel
  71. slots: {#selectedClass. #selectedPackage. #selectedProtocol. #selectedSelector}
  72. package: 'Helios-Core'!
  73. !HLToolModel commentStamp!
  74. I am a model specific to package and class manipulation. All browsers should either use me or a subclass as their model.
  75. I provide methods for package, class, protocol and method manipulation and access, forwarding to my environment.
  76. I also handle compilation of classes and methods as well as compilation and parsing errors.!
  77. !HLToolModel methodsFor: 'accessing'!
  78. allSelectors
  79. ^ self environment allSelectors
  80. !
  81. availableClassNames
  82. ^ self environment availableClassNames
  83. !
  84. availablePackageNames
  85. ^ self environment availablePackageNames
  86. !
  87. availablePackages
  88. ^ self environment availablePackageNames
  89. !
  90. availableProtocols
  91. ^ self environment availableProtocolsFor: self selectedClass
  92. !
  93. packageToCommit
  94. "Answer the package to commit depending on the context:
  95. - if a Method is selected, answer its package
  96. - else answer the `selectedPackage`"
  97. ^ self selectedMethod
  98. ifNil: [ self selectedPackage ]
  99. ifNotNil: [ :method | method package ]
  100. !
  101. packages
  102. ^ self environment packages
  103. !
  104. selectedClass
  105. ^ selectedClass
  106. !
  107. selectedClass: aClass
  108. (self selectedClass = aClass and: [ aClass isNil ])
  109. ifTrue: [ ^ self ].
  110. self withChangesDo: [
  111. aClass
  112. ifNil: [ selectedClass := nil ]
  113. ifNotNil: [
  114. self selectedPackage: aClass theNonMetaClass package.
  115. self showInstance
  116. ifTrue: [ selectedClass := aClass theNonMetaClass ]
  117. ifFalse: [ selectedClass := aClass theMetaClass ] ].
  118. selectedProtocol := nil.
  119. self selectedProtocol: self allProtocol.
  120. self announcer announce: (HLClassSelected on: self selectedClass) ]
  121. !
  122. selectedMethod
  123. ^ self selectedClass ifNotNil: [
  124. self selectedClass methodDictionary
  125. at: selectedSelector
  126. ifAbsent: [ nil ] ]
  127. !
  128. selectedMethod: aCompiledMethod
  129. selectedSelector = aCompiledMethod ifTrue: [ ^ self ].
  130. self withChangesDo: [
  131. aCompiledMethod
  132. ifNil: [ selectedSelector := nil ]
  133. ifNotNil: [
  134. selectedSelector := aCompiledMethod selector.
  135. (selectedClass notNil and: [ selectedClass methodDictionary includesKey: selectedSelector ]) ifFalse: [
  136. selectedClass := aCompiledMethod methodClass.
  137. selectedPackage := selectedClass theNonMetaClass package ] ].
  138. self announcer announce: (HLMethodSelected on: aCompiledMethod) ]
  139. !
  140. selectedPackage
  141. ^ selectedPackage
  142. !
  143. selectedPackage: aPackage
  144. selectedPackage = aPackage ifTrue: [ ^ self ].
  145. self withChangesDo: [
  146. selectedPackage := aPackage.
  147. self selectedClass: nil.
  148. self announcer announce: (HLPackageSelected on: aPackage) ]
  149. !
  150. selectedProtocol
  151. ^ selectedProtocol
  152. !
  153. selectedProtocol: aString
  154. selectedProtocol = aString ifTrue: [ ^ self ].
  155. self withChangesDo: [
  156. selectedProtocol := aString.
  157. self selectedMethod: nil.
  158. self announcer announce: (HLProtocolSelected on: aString) ]
  159. !
  160. softSelectedClass: aClass
  161. self announcer announce: (HLClassSelected softOn: aClass)
  162. !
  163. softSelectedMethod: aMethod
  164. self announcer announce: (HLMethodSelected softOn: aMethod)
  165. !
  166. softSelectedPackage: aPackage
  167. self announcer announce: (HLPackageSelected softOn: aPackage)
  168. !
  169. softSelectedProtocol: aProtocol
  170. self announcer announce: (HLProtocolSelected softOn: aProtocol)
  171. ! !
  172. !HLToolModel methodsFor: 'actions'!
  173. addInstVarNamed: aString
  174. self environment addInstVarNamed: aString to: self selectedClass.
  175. self announcer announce: (HLInstVarAdded new
  176. theClass: self selectedClass;
  177. variableName: aString;
  178. yourself)
  179. !
  180. save: aString
  181. self announcer announce: HLSourceCodeSaved new.
  182. (self shouldCompileDefinition: aString)
  183. ifTrue: [ self compileClassDefinition: aString ]
  184. ifFalse: [ self compileMethod: aString ]
  185. !
  186. saveSourceCode
  187. self announcer announce: HLSaveSourceCode new
  188. ! !
  189. !HLToolModel methodsFor: 'commands actions'!
  190. commitPackageOnSuccess: aBlock onError: anotherBlock
  191. self environment
  192. commitPackage: self packageToCommit
  193. onSuccess: aBlock
  194. onError: anotherBlock
  195. !
  196. copyClassTo: aClassName
  197. self withChangesDo: [
  198. self environment
  199. copyClass: self selectedClass theNonMetaClass
  200. to: aClassName.
  201. self selectedClass: (self environment classNamed: aClassName) ]
  202. !
  203. moveClassToPackage: aPackageName
  204. self withChangesDo: [
  205. self environment
  206. moveClass: self selectedClass theNonMetaClass
  207. toPackage: aPackageName ]
  208. !
  209. moveMethodToClass: aClassName
  210. self withChangesDo: [
  211. self environment
  212. moveMethod: self selectedMethod
  213. toClass: aClassName ]
  214. !
  215. moveMethodToProtocol: aProtocol
  216. self withChangesDo: [
  217. self environment
  218. moveMethod: self selectedMethod
  219. toProtocol: aProtocol ]
  220. !
  221. openClassNamed: aString
  222. | class |
  223. self withChangesDo: [
  224. class := self environment classNamed: aString.
  225. self selectedPackage: class package.
  226. self selectedClass: class ]
  227. !
  228. removeClass
  229. self withChangesDo: [
  230. self manager
  231. confirm: 'Do you REALLY want to remove class ', self selectedClass theNonMetaClass name
  232. ifTrue: [ self environment removeClass: self selectedClass theNonMetaClass ] ]
  233. !
  234. removeMethod
  235. self withChangesDo: [
  236. self manager
  237. confirm: 'Do you REALLY want to remove method ', self selectedMethod origin name,' >> #', self selectedMethod selector
  238. ifTrue: [ self environment removeMethod: self selectedMethod ] ]
  239. !
  240. removeProtocol
  241. self withChangesDo: [
  242. self manager
  243. confirm: 'Do you REALLY want to remove protocol ', self selectedProtocol
  244. ifTrue: [ self environment
  245. removeProtocol: self selectedProtocol
  246. from: self selectedClass ] ]
  247. !
  248. renameClassTo: aClassName
  249. self withChangesDo: [
  250. self environment
  251. renameClass: self selectedClass theNonMetaClass
  252. to: aClassName ]
  253. !
  254. renamePackageTo: aPackageName
  255. self withChangesDo: [
  256. self environment
  257. renamePackage: self selectedPackage name
  258. to: aPackageName ]
  259. !
  260. renameProtocolTo: aString
  261. self withChangesDo: [
  262. self environment
  263. renameProtocol: self selectedProtocol
  264. to: aString
  265. in: self selectedClass ]
  266. ! !
  267. !HLToolModel methodsFor: 'compiling'!
  268. compileClassComment: aString
  269. self environment
  270. compileClassComment: aString
  271. for: self selectedClass
  272. !
  273. compileClassDefinition: aString
  274. self environment compileClassDefinition: aString
  275. !
  276. compileMethod: aString
  277. | method |
  278. self withCompileErrorHandling: [
  279. method := self environment
  280. compileMethod: aString
  281. for: self selectedClass
  282. protocol: self compilationProtocol.
  283. self selectedMethod: method ]
  284. ! !
  285. !HLToolModel methodsFor: 'defaults'!
  286. allProtocol
  287. ^ '-- all --'
  288. !
  289. unclassifiedProtocol
  290. ^ 'as yet unclassified'
  291. ! !
  292. !HLToolModel methodsFor: 'error handling'!
  293. handleCompileError: anError
  294. self announcer announce: (HLCompileErrorRaised new
  295. error: anError;
  296. yourself)
  297. !
  298. handleParseError: anError
  299. | split line column messageToInsert |
  300. split := anError messageText tokenize: ' : '.
  301. messageToInsert := split second.
  302. "21 = 'Parse error on line ' size + 1"
  303. split := split first copyFrom: 21 to: split first size.
  304. split := split tokenize: ' column '.
  305. line := split first.
  306. column := split second.
  307. self announcer announce: (HLParseErrorRaised new
  308. line: line asNumber;
  309. column: column asNumber;
  310. message: messageToInsert;
  311. error: anError;
  312. yourself)
  313. !
  314. handleUnkownVariableError: anError
  315. self announcer announce: (HLUnknownVariableErrorRaised new
  316. error: anError;
  317. yourself)
  318. !
  319. withCompileErrorHandling: aBlock
  320. self environment
  321. evaluate: [
  322. self environment
  323. evaluate: [
  324. self environment
  325. evaluate: aBlock
  326. on: ParseError
  327. do: [ :ex | self handleParseError: ex ] ]
  328. on: UnknownVariableError
  329. do: [ :ex | self handleUnkownVariableError: ex ] ]
  330. on: CompilerError
  331. do: [ :ex | self handleCompileError: ex ]
  332. ! !
  333. !HLToolModel methodsFor: 'private'!
  334. compilationProtocol
  335. | currentProtocol |
  336. currentProtocol := self selectedProtocol.
  337. currentProtocol ifNil: [ currentProtocol := self unclassifiedProtocol ].
  338. self selectedMethod ifNotNil: [ currentProtocol := self selectedMethod protocol ].
  339. ^ currentProtocol = self allProtocol
  340. ifTrue: [ self unclassifiedProtocol ]
  341. ifFalse: [ currentProtocol ]
  342. !
  343. withHelperLabelled: aString do: aBlock
  344. "TODO: doesn't belong here"
  345. '#helper' asJQuery remove.
  346. [ :html |
  347. html div
  348. id: 'helper';
  349. with: aString ] appendToJQuery: 'body' asJQuery.
  350. [
  351. aBlock value.
  352. '#helper' asJQuery remove ] fork
  353. ! !
  354. !HLToolModel methodsFor: 'testing'!
  355. isToolModel
  356. ^ true
  357. !
  358. shouldCompileDefinition: aString
  359. ^ self selectedClass isNil or: [
  360. aString match: '^\s*[A-Z]' ]
  361. ! !
  362. !HLToolModel class methodsFor: 'actions'!
  363. on: anEnvironment
  364. ^ self new
  365. environment: anEnvironment;
  366. yourself
  367. ! !
  368. Object subclass: #HLProgressHandler
  369. slots: {}
  370. package: 'Helios-Core'!
  371. !HLProgressHandler commentStamp!
  372. I am a specific progress handler for Helios, displaying progresses in a modal window.!
  373. !HLProgressHandler methodsFor: 'progress handling'!
  374. do: aBlock on: aCollection displaying: aString
  375. HLProgressWidget default
  376. do: aBlock
  377. on: aCollection
  378. displaying: aString
  379. ! !
  380. Widget subclass: #HLWidget
  381. slots: {#wrapper}
  382. package: 'Helios-Core'!
  383. !HLWidget commentStamp!
  384. I am the abstract superclass of all Helios widgets.
  385. I provide common methods, additional behavior to widgets useful for Helios, like dialog creation, command execution and tab creation.
  386. ## API
  387. 1. Rendering
  388. Instead of overriding `#renderOn:` as with other Widget subclasses, my subclasses should override `#renderContentOn:`.
  389. 2. Refreshing
  390. To re-render a widget, use `#refresh`.
  391. 3. Key bindings registration and tabs
  392. When displayed as a tab, the widget has a chance to register keybindings with the `#registerBindingsOn:` hook method.
  393. 4. Unregistration
  394. When a widget has subscribed to announcements or other actions that need to be cleared when closing the tab, the hook method `#unregister` will be called by helios.
  395. 5. Tabs
  396. To enable a widget class to be open as a tab, override the class-side `#canBeOpenAsTab` method to answer `true`. `#tabClass` and `#tabPriority` can be overridden too to respectively change the css class of the tab and the order of tabs in the main menu.
  397. 6. Command execution
  398. An helios command (instance of `HLCommand` or one of its subclass) can be executed with `#execute:`.!
  399. !HLWidget methodsFor: 'accessing'!
  400. cssClass
  401. ^ 'hl_widget'
  402. !
  403. manager
  404. ^ HLManager current
  405. !
  406. removeTab
  407. self manager removeTabForWidget: self
  408. !
  409. setTabLabel: aString
  410. self manager announcer announce: (HLTabLabelChanged new
  411. widget: self;
  412. label: aString;
  413. yourself)
  414. !
  415. tabClass
  416. ^ self class tabClass
  417. !
  418. wrapper
  419. ^ wrapper
  420. ! !
  421. !HLWidget methodsFor: 'actions'!
  422. confirm: aString ifTrue: aBlock
  423. self manager confirm: aString ifTrue: aBlock
  424. !
  425. confirm: aString ifTrue: aBlock ifFalse: anotherBlock
  426. self manager
  427. confirm: aString
  428. ifTrue: aBlock
  429. ifFalse: anotherBlock
  430. !
  431. execute: aCommand
  432. HLManager current keyBinder
  433. activate;
  434. applyBinding: aCommand asBinding
  435. !
  436. inform: aString
  437. self manager inform: aString
  438. !
  439. openAsTab
  440. (HLTabWidget on: self labelled: self defaultTabLabel)
  441. add
  442. !
  443. request: aString do: aBlock
  444. self manager request: aString do: aBlock
  445. !
  446. request: aString value: valueString do: aBlock
  447. self manager
  448. request: aString
  449. value: valueString
  450. do: aBlock
  451. !
  452. unregister
  453. "This method is called whenever the receiver is closed (as a tab).
  454. Widgets subscribing to announcements should unregister there"
  455. ! !
  456. !HLWidget methodsFor: 'defaults'!
  457. defaultTabLabel
  458. ^ self class tabLabel
  459. ! !
  460. !HLWidget methodsFor: 'keybindings'!
  461. bindKeyDown: keyDownBlock keyUp: keyUpBlock
  462. self wrapper ifNotNil: [ wrapper
  463. onKeyDown: keyDownBlock;
  464. onKeyUp: keyUpBlock ]
  465. !
  466. registerBindings
  467. self registerBindingsOn: self manager keyBinder bindings
  468. !
  469. registerBindingsOn: aBindingGroup
  470. !
  471. unbindKeyDownKeyUp
  472. self wrapper asJQuery
  473. unbind: 'keydown';
  474. unbind: 'keyup'
  475. ! !
  476. !HLWidget methodsFor: 'rendering'!
  477. renderContentOn: html
  478. !
  479. renderOn: html
  480. wrapper := html div
  481. class: self cssClass;
  482. yourself.
  483. "must do this later, as renderContentOn may want to use self wrapper"
  484. wrapper with: [ self renderContentOn: html ]
  485. ! !
  486. !HLWidget methodsFor: 'testing'!
  487. canHaveFocus
  488. ^ false
  489. ! !
  490. !HLWidget methodsFor: 'updating'!
  491. refresh
  492. self wrapper
  493. ifNotNil: [ :wrap | wrap contents: [ :html | self renderContentOn: html ] ]
  494. ! !
  495. !HLWidget class methodsFor: 'accessing'!
  496. openAsTab
  497. | instance |
  498. instance := self new.
  499. (HLTabWidget
  500. on: instance
  501. labelled: instance defaultTabLabel) add.
  502. ^ instance
  503. !
  504. tabClass
  505. ^ ''
  506. !
  507. tabLabel
  508. ^ 'Tab'
  509. !
  510. tabPriority
  511. ^ 500
  512. ! !
  513. !HLWidget class methodsFor: 'testing'!
  514. canBeOpenAsTab
  515. ^ false
  516. ! !
  517. HLWidget subclass: #HLFocusableWidget
  518. slots: {}
  519. package: 'Helios-Core'!
  520. !HLFocusableWidget commentStamp!
  521. I am a widget that can be focused.
  522. ## API
  523. Instead of overriding `#renderOn:` as with other `Widget` subclasses, my subclasses should override `#renderContentOn:`.
  524. To bring the focus to the widget, use the `#focus` method.!
  525. !HLFocusableWidget methodsFor: 'accessing'!
  526. focusClass
  527. ^ 'focused'
  528. ! !
  529. !HLFocusableWidget methodsFor: 'events'!
  530. blur
  531. self wrapper asJQuery blur
  532. !
  533. focus
  534. self wrapper asJQuery focus
  535. ! !
  536. !HLFocusableWidget methodsFor: 'rendering'!
  537. renderContentOn: html
  538. !
  539. renderOn: html
  540. wrapper := html div
  541. class: self cssClass;
  542. at: 'tabindex' put: '0';
  543. onBlur: [ self wrapper asJQuery removeClass: self focusClass ];
  544. onFocus: [ self wrapper asJQuery addClass: self focusClass ];
  545. yourself.
  546. "must do this later, as renderContentOn may want to use self wrapper"
  547. wrapper with: [ self renderContentOn: html ]
  548. ! !
  549. !HLFocusableWidget methodsFor: 'testing'!
  550. canHaveFocus
  551. ^ true
  552. !
  553. hasFocus
  554. ^ self wrapper notNil and: [ self wrapper asJQuery hasClass: self focusClass ]
  555. ! !
  556. HLFocusableWidget subclass: #HLListWidget
  557. slots: {#items. #selectedItem}
  558. package: 'Helios-Core'!
  559. !HLListWidget methodsFor: 'accessing'!
  560. activeItemCssClass
  561. ^'active'
  562. !
  563. buttonsDivCssClass
  564. ^ 'pane_actions form-group'
  565. !
  566. cssClassForItem: anObject
  567. ^ ''
  568. !
  569. findListItemFor: anObject
  570. ^ (((wrapper asJQuery find: 'li')
  571. filter: [ :thisArg :otherArg | (thisArg asJQuery data: 'item') = anObject ] currySelf) eq: 0)
  572. !
  573. items
  574. ^ items ifNil: [ items := self defaultItems ]
  575. !
  576. items: aCollection
  577. items := aCollection
  578. !
  579. listCssClass
  580. ^'nav nav-pills nav-stacked'
  581. !
  582. listCssClassForItem: anObject
  583. ^ self selectedItem = anObject
  584. ifTrue: [ self activeItemCssClass ]
  585. ifFalse: [ 'inactive' ]
  586. !
  587. positionOf: aListItem
  588. <inlineJS: '
  589. return aListItem.parent().children().get().indexOf(aListItem.get(0)) + 1
  590. '>
  591. !
  592. selectedItem
  593. ^ selectedItem
  594. !
  595. selectedItem: anObject
  596. selectedItem := anObject
  597. ! !
  598. !HLListWidget methodsFor: 'actions'!
  599. activateFirstListItem
  600. self activateListItem: ((wrapper asJQuery find: 'li.inactive') eq: 0)
  601. !
  602. activateItem: anObject
  603. self activateListItem: (self findListItemFor: anObject)
  604. !
  605. activateListItem: aListItem
  606. | item |
  607. (aListItem get: 0) ifNil: [ ^ self ].
  608. aListItem parent children removeClass: self activeItemCssClass.
  609. aListItem addClass: self activeItemCssClass.
  610. self ensureVisible: aListItem.
  611. "Activate the corresponding item"
  612. item := aListItem data: 'item'.
  613. self selectedItem == item ifFalse: [
  614. self selectItem: item ]
  615. !
  616. activateNextListItem
  617. self activateListItem: (self wrapper asJQuery find: ('li.', self activeItemCssClass)) next.
  618. "select the first item if none is selected"
  619. (self wrapper asJQuery find: (' .', self activeItemCssClass)) get ifEmpty: [
  620. self activateFirstListItem ]
  621. !
  622. activatePreviousListItem
  623. self activateListItem: (self wrapper asJQuery find: ('li.', self activeItemCssClass)) prev
  624. !
  625. ensureVisible: aListItem
  626. "Move the scrollbar to show the active element"
  627. | parent position |
  628. (aListItem get: 0) ifNil: [ ^ self ].
  629. position := self positionOf: aListItem.
  630. parent := aListItem parent.
  631. aListItem position top < 0 ifTrue: [
  632. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem position top - 10) ].
  633. aListItem position top + aListItem height > parent height ifTrue: [
  634. (parent get: 0) scrollTop: ((parent get: 0) scrollTop + aListItem height - (parent height - aListItem position top)) +10 ]
  635. !
  636. focus
  637. super focus.
  638. self items ifNotEmpty: [
  639. self selectedItem ifNil: [ self activateFirstListItem ] ]
  640. !
  641. reactivateListItem: aListItem
  642. self activateListItem: aListItem.
  643. self reselectItem: self selectedItem
  644. !
  645. refresh
  646. super refresh.
  647. self selectedItem ifNotNil: [self ensureVisible: (self findListItemFor: self selectedItem)].
  648. !
  649. reselectItem: anObject
  650. !
  651. selectItem: anObject
  652. self selectedItem: anObject
  653. ! !
  654. !HLListWidget methodsFor: 'defaults'!
  655. defaultItems
  656. ^ #()
  657. ! !
  658. !HLListWidget methodsFor: 'events'!
  659. setupKeyBindings
  660. (HLRepeatedKeyDownHandler on: self)
  661. whileKeyDown: 38 do: [ self activatePreviousListItem ];
  662. whileKeyDown: 40 do: [ self activateNextListItem ];
  663. rebindKeys.
  664. self wrapper asJQuery keydown: [ :e |
  665. e which = 13 ifTrue: [
  666. self reselectItem: self selectedItem ] ]
  667. ! !
  668. !HLListWidget methodsFor: 'rendering'!
  669. renderButtonsOn: html
  670. !
  671. renderContentOn: html
  672. html ul
  673. class: self listCssClass;
  674. with: [ self renderListOn: html ];
  675. onClick: [ self focus ].
  676. html div class: self buttonsDivCssClass; with: [
  677. self renderButtonsOn: html ].
  678. self setupKeyBindings
  679. !
  680. renderItemLabel: anObject on: html
  681. html with: anObject asString
  682. !
  683. renderItemModel: anObject viewModel: anotherObject on: html
  684. | li |
  685. li := html li.
  686. li asJQuery data: 'item' put: anObject.
  687. li
  688. class: (self listCssClassForItem: anObject);
  689. with: [
  690. html a
  691. with: [
  692. (html tag: 'i') class: (self cssClassForItem: anObject).
  693. self renderItemLabel: anotherObject on: html ];
  694. onClick: [
  695. self reactivateListItem: li asJQuery ] ]
  696. !
  697. renderListOn: html
  698. self items do: [ :each |
  699. self renderItemModel: each viewModel: each on: html ]
  700. ! !
  701. HLListWidget subclass: #HLNavigationListWidget
  702. slots: {#previous. #next}
  703. package: 'Helios-Core'!
  704. !HLNavigationListWidget methodsFor: 'accessing'!
  705. next
  706. ^ next
  707. !
  708. next: aWidget
  709. next := aWidget.
  710. aWidget previous = self ifFalse: [ aWidget previous: self ]
  711. !
  712. previous
  713. ^ previous
  714. !
  715. previous: aWidget
  716. previous := aWidget.
  717. aWidget next = self ifFalse: [ aWidget next: self ]
  718. ! !
  719. !HLNavigationListWidget methodsFor: 'actions'!
  720. nextFocus
  721. self next ifNotNil: [ self next focus ]
  722. !
  723. previousFocus
  724. self previous ifNotNil: [ self previous focus ]
  725. ! !
  726. !HLNavigationListWidget methodsFor: 'events'!
  727. setupKeyBindings
  728. super setupKeyBindings.
  729. self wrapper ifNotNil: [ wrapper onKeyDown: [ :e |
  730. e which = 39 ifTrue: [
  731. self nextFocus ].
  732. e which = 37 ifTrue: [
  733. self previousFocus ] ] ]
  734. ! !
  735. HLNavigationListWidget subclass: #HLToolListWidget
  736. slots: {#model}
  737. package: 'Helios-Core'!
  738. !HLToolListWidget methodsFor: 'accessing'!
  739. commandCategory
  740. ^ self label
  741. !
  742. label
  743. ^ 'List'
  744. !
  745. menuCommands
  746. "Answer a collection of commands to be put in the cog menu"
  747. ^ ((HLToolCommand concreteClasses
  748. select: [ :each | each isValidFor: self model ])
  749. collect: [ :each | each for: self model ])
  750. select: [ :each |
  751. each category = self commandCategory and: [
  752. each isAction and: [ each isActive ] ] ]
  753. !
  754. model
  755. ^ model
  756. !
  757. model: aBrowserModel
  758. model := aBrowserModel.
  759. self
  760. observeSystem;
  761. observeModel
  762. !
  763. selectedItem: anItem
  764. "Selection changed, update the cog menu"
  765. super selectedItem: anItem.
  766. self updateMenu
  767. ! !
  768. !HLToolListWidget methodsFor: 'actions'!
  769. activateListItem: anItem
  770. self model withChangesDo: [ super activateListItem: anItem ]
  771. !
  772. activateNextListItem
  773. self model withChangesDo: [ super activateNextListItem ]
  774. !
  775. activatePreviousListItem
  776. self model withChangesDo: [ super activatePreviousListItem ]
  777. !
  778. observeModel
  779. !
  780. observeSystem
  781. !
  782. reactivateListItem: anItem
  783. self model withChangesDo: [ super reactivateListItem: anItem ]
  784. !
  785. unregister
  786. super unregister.
  787. self model announcer unsubscribe: self.
  788. self model systemAnnouncer unsubscribe: self
  789. ! !
  790. !HLToolListWidget methodsFor: 'rendering'!
  791. renderContentOn: html
  792. self renderHeadOn: html.
  793. super renderContentOn: html
  794. !
  795. renderHeadOn: html
  796. html div
  797. class: 'list-label';
  798. with: [
  799. html with: self label.
  800. self renderMenuOn: html ]
  801. !
  802. renderMenuOn: html
  803. | commands |
  804. commands := self menuCommands.
  805. commands ifEmpty: [ ^ self ].
  806. html div
  807. class: 'btn-group cog';
  808. with: [
  809. html a
  810. class: 'btn btn-default dropdown-toggle';
  811. at: 'data-toggle' put: 'dropdown';
  812. with: [ (html tag: 'i') class: 'glyphicon glyphicon-chevron-down' ].
  813. html ul
  814. class: 'dropdown-menu pull-right';
  815. with: [
  816. commands do: [ :each |
  817. html li with: [ html a
  818. with: each menuLabel;
  819. onClick: [ self execute: each ] ] ] ] ]
  820. ! !
  821. !HLToolListWidget methodsFor: 'updating'!
  822. updateMenu
  823. (self wrapper asJQuery find: '.cog') remove.
  824. [ :html | self renderMenuOn: html ]
  825. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  826. ! !
  827. !HLToolListWidget class methodsFor: 'instance creation'!
  828. on: aModel
  829. ^ self new
  830. model: aModel;
  831. yourself
  832. ! !
  833. HLListWidget subclass: #HLTabListWidget
  834. slots: {#callback}
  835. package: 'Helios-Core'!
  836. !HLTabListWidget commentStamp!
  837. I am a widget used to display a list of helios tabs.
  838. When a tab is selected, `callback` is evaluated with the selected tab as argument.!
  839. !HLTabListWidget methodsFor: 'accessing'!
  840. callback
  841. ^ callback ifNil: [ [] ]
  842. !
  843. callback: aBlock
  844. callback := aBlock
  845. ! !
  846. !HLTabListWidget methodsFor: 'actions'!
  847. selectItem: aTab
  848. super selectItem: aTab.
  849. self callback value: aTab
  850. ! !
  851. !HLTabListWidget methodsFor: 'rendering'!
  852. renderItemLabel: aTab on: html
  853. html span
  854. class: aTab cssClass;
  855. with: aTab label
  856. ! !
  857. HLWidget subclass: #HLInformationWidget
  858. slots: {#informationString}
  859. package: 'Helios-Core'!
  860. !HLInformationWidget commentStamp!
  861. I display an information dialog.
  862. ## API
  863. `HLWidget >> #inform:` is a convenience method for creating information dialogs.!
  864. !HLInformationWidget methodsFor: 'accessing'!
  865. informationString
  866. ^ informationString ifNil: [ '' ]
  867. !
  868. informationString: anObject
  869. informationString := anObject
  870. ! !
  871. !HLInformationWidget methodsFor: 'actions'!
  872. remove
  873. [
  874. self wrapper asJQuery fadeOut: 100.
  875. [ self wrapper asJQuery remove ]
  876. valueWithTimeout: 400.
  877. ]
  878. valueWithTimeout: 1500
  879. !
  880. show
  881. self appendToJQuery: 'body' asJQuery
  882. ! !
  883. !HLInformationWidget methodsFor: 'rendering'!
  884. renderContentOn: html
  885. html div
  886. class: 'growl';
  887. with: self informationString.
  888. self remove
  889. ! !
  890. HLWidget subclass: #HLManager
  891. slots: {#tabsWidget. #environment. #history. #announcer. #rendered}
  892. package: 'Helios-Core'!
  893. !HLManager commentStamp!
  894. HLManager is the entry point Class of Helios.
  895. Its `singleton` instance is created on startup, and rendered on body.!
  896. !HLManager methodsFor: 'accessing'!
  897. activeTab
  898. ^ self tabsWidget activeTab
  899. !
  900. announcer
  901. ^ announcer ifNil: [ announcer := Announcer new ]
  902. !
  903. environment
  904. "The default environment used by all Helios objects"
  905. ^ environment ifNil: [ environment := self defaultEnvironment ]
  906. !
  907. environment: anEnvironment
  908. environment := anEnvironment
  909. !
  910. history
  911. ^ history ifNil: [ history := OrderedCollection new ]
  912. !
  913. history: aCollection
  914. history := aCollection
  915. !
  916. keyBinder
  917. ^ HLKeyBinder current
  918. !
  919. setEditorTheme: aTheme
  920. 'helios.editorTheme' asSetting value: aTheme
  921. !
  922. setTheme: aTheme
  923. | currentTheme |
  924. currentTheme := 'helios.theme' asSettingIfAbsent: 'default'.
  925. 'body' asJQuery
  926. removeClass: currentTheme value;
  927. addClass: aTheme.
  928. 'helios.theme' asSetting value: aTheme
  929. !
  930. tabWidth
  931. ^ (window asJQuery width - 90) / self tabs size
  932. !
  933. tabs
  934. ^ self tabsWidget tabs
  935. !
  936. tabsWidget
  937. ^ tabsWidget ifNil: [ tabsWidget := HLTabsWidget new ]
  938. ! !
  939. !HLManager methodsFor: 'actions'!
  940. activate: aTab
  941. self tabsWidget activate: aTab
  942. !
  943. addTab: aTab
  944. self tabsWidget addTab: aTab
  945. !
  946. confirm: aString ifFalse: aBlock
  947. self
  948. confirm: aString
  949. ifTrue: []
  950. ifFalse: aBlock
  951. !
  952. confirm: aString ifTrue: aBlock
  953. self
  954. confirm: aString
  955. ifTrue: aBlock
  956. ifFalse: []
  957. !
  958. confirm: aString ifTrue: aBlock ifFalse: anotherBlock
  959. HLConfirmationWidget new
  960. confirmationString: aString;
  961. actionBlock: aBlock;
  962. cancelBlock: anotherBlock;
  963. show
  964. !
  965. handleLossOfEnvironmentWithParent: parent
  966. parent at: 'onunload' put: [
  967. self removeBeforeUnloadMessage.
  968. window close ]
  969. !
  970. inform: aString
  971. HLInformationWidget new
  972. informationString: aString;
  973. show
  974. !
  975. removeActiveTab
  976. self tabsWidget removeActiveTab
  977. !
  978. removeBeforeUnloadMessage
  979. <inlineJS: 'window.onbeforeunload = null'>
  980. !
  981. removeTabForWidget: aWidget
  982. self tabsWidget removeTabForWidget: aWidget
  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. HLRequestWidget new
  992. confirmationString: aString;
  993. actionBlock: aBlock;
  994. value: valueString;
  995. show
  996. ! !
  997. !HLManager methodsFor: 'defaults'!
  998. defaultEnvironment
  999. "If helios is loaded from within a frame, answer the parent window environment"
  1000. | parent parentSmalltalkGlobals |
  1001. parent := window opener ifNil: [ window parent ].
  1002. parent ifNil: [ ^ Environment new ].
  1003. parentSmalltalkGlobals := ((parent at: 'requirejs') value: 'amber/boot') at: 'globals'.
  1004. parentSmalltalkGlobals ifNil: [ ^ Environment new ].
  1005. self handleLossOfEnvironmentWithParent: parent.
  1006. ^ (parentSmalltalkGlobals at: 'Environment') new
  1007. ! !
  1008. !HLManager methodsFor: 'initialization'!
  1009. initialize
  1010. super initialize.
  1011. rendered := false
  1012. !
  1013. setup
  1014. self
  1015. registerServices;
  1016. setupEvents.
  1017. self keyBinder setupEvents.
  1018. self tabsWidget setupEvents.
  1019. self setupTheme.
  1020. '#helper' asJQuery fadeOut
  1021. ! !
  1022. !HLManager methodsFor: 'private'!
  1023. registerServices
  1024. self
  1025. registerInspector;
  1026. registerErrorHandler;
  1027. registerProgressHandler;
  1028. registerTranscript;
  1029. registerFinder
  1030. !
  1031. setupEvents
  1032. 'body' asJQuery keydown: [ :event |
  1033. "On ctrl keydown, adds a 'navigation' css class to <body>
  1034. for the CodeMirror navigation links. See `HLCodeWidget`."
  1035. event ctrlKey ifTrue: [
  1036. 'body' asJQuery addClass: 'navigation' ] ].
  1037. 'body' asJQuery keyup: [ :event |
  1038. 'body' asJQuery removeClass: 'navigation' ].
  1039. window asJQuery resize: [ :event |
  1040. self refresh ]
  1041. !
  1042. setupTheme
  1043. "self
  1044. setTheme: 'niflheim';
  1045. setEditorTheme: 'niflheim'."
  1046. self
  1047. setTheme: 'default';
  1048. setEditorTheme: 'default'.
  1049. ! !
  1050. !HLManager methodsFor: 'rendering'!
  1051. renderContentOn: html
  1052. html with: self tabsWidget.
  1053. html with: HLWelcomeWidget new.
  1054. self renderDefaultTabs.
  1055. rendered := true
  1056. !
  1057. renderDefaultTabs
  1058. rendered ifFalse: [
  1059. HLWorkspace openAsTab.
  1060. HLBrowser openAsTab ]
  1061. ! !
  1062. !HLManager methodsFor: 'services'!
  1063. registerErrorHandler
  1064. self environment registerErrorHandler: HLErrorHandler new.
  1065. ErrorHandler register: HLErrorHandler new
  1066. !
  1067. registerFinder
  1068. self environment registerFinder: HLFinder new.
  1069. Finder register: HLFinder new
  1070. !
  1071. registerInspector
  1072. self environment registerInspector: HLInspector.
  1073. Inspector register: HLInspector
  1074. !
  1075. registerProgressHandler
  1076. self environment registerProgressHandler: HLProgressHandler new.
  1077. ProgressHandler register: HLProgressHandler new
  1078. !
  1079. registerTranscript
  1080. self environment registerTranscript: HLTranscriptHandler
  1081. ! !
  1082. HLManager class slots: {#current}!
  1083. !HLManager class methodsFor: 'accessing'!
  1084. current
  1085. ^ current ifNil: [ current := self basicNew initialize ]
  1086. ! !
  1087. !HLManager class methodsFor: 'initialization'!
  1088. setup
  1089. self current
  1090. setup;
  1091. appendToJQuery: 'body' asJQuery.
  1092. ('helios.confirmOnExit' settingValueIfAbsent: true) ifTrue: [
  1093. window onbeforeunload: [ 'Do you want to close Amber? All uncommitted changes will be lost.' ] ]
  1094. ! !
  1095. !HLManager class methodsFor: 'instance creation'!
  1096. new
  1097. "Use current instead"
  1098. self shouldNotImplement
  1099. ! !
  1100. HLWidget subclass: #HLModalWidget
  1101. slots: {}
  1102. package: 'Helios-Core'!
  1103. !HLModalWidget commentStamp!
  1104. I implement an abstract modal widget.!
  1105. !HLModalWidget methodsFor: 'actions'!
  1106. remove
  1107. '.dialog' asJQuery removeClass: 'active'.
  1108. [
  1109. '#overlay' asJQuery remove.
  1110. wrapper asJQuery remove
  1111. ] valueWithTimeout: 300
  1112. !
  1113. show
  1114. self appendToJQuery: 'body' asJQuery
  1115. ! !
  1116. !HLModalWidget methodsFor: 'private'!
  1117. giveFocusToButton: aButton
  1118. aButton asJQuery focus
  1119. ! !
  1120. !HLModalWidget methodsFor: 'rendering'!
  1121. hasButtons
  1122. ^ true
  1123. !
  1124. renderButtonsOn: html
  1125. !
  1126. renderContentOn: html
  1127. | confirmButton |
  1128. html div id: 'overlay'.
  1129. html div
  1130. class: 'dialog ', self cssClass;
  1131. with: [
  1132. self renderMainOn: html.
  1133. self hasButtons ifTrue: [
  1134. self renderButtonsOn: html ] ].
  1135. '.dialog' asJQuery addClass: 'active'.
  1136. self setupKeyBindings
  1137. !
  1138. renderMainOn: html
  1139. !
  1140. setupKeyBindings
  1141. '.dialog' asJQuery keyup: [ :e |
  1142. e keyCode = String esc asciiValue ifTrue: [ self cancel ] ]
  1143. ! !
  1144. HLModalWidget subclass: #HLConfirmationWidget
  1145. slots: {#cancelButtonLabel. #confirmButtonLabel. #confirmationString. #actionBlock. #cancelBlock}
  1146. package: 'Helios-Core'!
  1147. !HLConfirmationWidget commentStamp!
  1148. I display confirmation dialog.
  1149. ## API
  1150. HLWidget contains convenience methods like `HLWidget >> #confirm:ifTrue:` for creating confirmation dialogs.!
  1151. !HLConfirmationWidget methodsFor: 'accessing'!
  1152. actionBlock
  1153. ^ actionBlock ifNil: [ [] ]
  1154. !
  1155. actionBlock: aBlock
  1156. actionBlock := aBlock
  1157. !
  1158. cancelBlock
  1159. ^ cancelBlock ifNil: [ [] ]
  1160. !
  1161. cancelBlock: aBlock
  1162. cancelBlock := aBlock
  1163. !
  1164. cancelButtonLabel
  1165. ^ cancelButtonLabel ifNil: [ 'Cancel' ]
  1166. !
  1167. cancelButtonLabel: aString
  1168. ^ cancelButtonLabel := aString
  1169. !
  1170. confirmButtonLabel
  1171. ^ confirmButtonLabel ifNil: [ 'Confirm' ]
  1172. !
  1173. confirmButtonLabel: aString
  1174. ^ confirmButtonLabel := aString
  1175. !
  1176. confirmationString
  1177. ^ confirmationString ifNil: [ 'Confirm' ]
  1178. !
  1179. confirmationString: aString
  1180. confirmationString := aString
  1181. ! !
  1182. !HLConfirmationWidget methodsFor: 'actions'!
  1183. cancel
  1184. self cancelBlock value.
  1185. self remove
  1186. !
  1187. confirm
  1188. self remove.
  1189. self actionBlock value
  1190. ! !
  1191. !HLConfirmationWidget methodsFor: 'rendering'!
  1192. renderButtonsOn: html
  1193. | confirmButton |
  1194. html div
  1195. class: 'buttons';
  1196. with: [
  1197. html button
  1198. class: 'button';
  1199. with: self cancelButtonLabel;
  1200. onClick: [ self cancel ].
  1201. confirmButton := html button
  1202. class: 'button default';
  1203. with: self confirmButtonLabel;
  1204. onClick: [ self confirm ] ].
  1205. self giveFocusToButton:confirmButton
  1206. !
  1207. renderMainOn: html
  1208. html span
  1209. class: 'head';
  1210. with: self confirmationString
  1211. ! !
  1212. HLConfirmationWidget subclass: #HLRequestWidget
  1213. slots: {#input. #multiline. #value}
  1214. package: 'Helios-Core'!
  1215. !HLRequestWidget commentStamp!
  1216. I display a modal window requesting user input.
  1217. ## API
  1218. `HLWidget >> #request:do:` and `#request:value:do:` are convenience methods for creating modal request dialogs.!
  1219. !HLRequestWidget methodsFor: 'accessing'!
  1220. beMultiline
  1221. multiline := true
  1222. !
  1223. beSingleline
  1224. multiline := false
  1225. !
  1226. cssClass
  1227. ^ 'large'
  1228. !
  1229. value
  1230. ^ value ifNil: [ '' ]
  1231. !
  1232. value: aString
  1233. value := aString
  1234. ! !
  1235. !HLRequestWidget methodsFor: 'actions'!
  1236. confirm
  1237. | val |
  1238. val := input asJQuery val.
  1239. self remove.
  1240. self actionBlock value: val
  1241. ! !
  1242. !HLRequestWidget methodsFor: 'private'!
  1243. giveFocusToButton: aButton
  1244. ! !
  1245. !HLRequestWidget methodsFor: 'rendering'!
  1246. renderMainOn: html
  1247. super renderMainOn: html.
  1248. self isMultiline
  1249. ifTrue: [ input := html textarea ]
  1250. ifFalse: [ input := html input
  1251. type: 'text';
  1252. onKeyDown: [ :event |
  1253. event keyCode = 13 ifTrue: [
  1254. self confirm ] ];
  1255. yourself ].
  1256. input asJQuery
  1257. val: self value;
  1258. focus
  1259. ! !
  1260. !HLRequestWidget methodsFor: 'testing'!
  1261. isMultiline
  1262. ^ multiline ifNil: [ true ]
  1263. ! !
  1264. HLModalWidget subclass: #HLProgressWidget
  1265. slots: {#progressBars. #visible}
  1266. package: 'Helios-Core'!
  1267. !HLProgressWidget commentStamp!
  1268. I am a widget used to display progress modal dialogs.
  1269. My default instance is accessed with `HLProgressWidget class >> #default`.
  1270. See `HLProgressHandler` for usage.!
  1271. !HLProgressWidget methodsFor: 'accessing'!
  1272. progressBars
  1273. ^ progressBars ifNil: [ progressBars := OrderedCollection new ]
  1274. ! !
  1275. !HLProgressWidget methodsFor: 'actions'!
  1276. addProgressBar: aProgressBar
  1277. self show.
  1278. self progressBars add: aProgressBar.
  1279. aProgressBar appendToJQuery: (self wrapper asJQuery find: '.dialog')
  1280. !
  1281. do: aBlock on: aCollection displaying: aString
  1282. | progressBar |
  1283. progressBar := HLProgressBarWidget new
  1284. parent: self;
  1285. label: aString;
  1286. workBlock: aBlock;
  1287. collection: aCollection;
  1288. yourself.
  1289. self addProgressBar: progressBar.
  1290. progressBar start
  1291. !
  1292. flush
  1293. self progressBars do: [ :each |
  1294. self removeProgressBar: each ]
  1295. !
  1296. remove
  1297. self isVisible ifTrue: [
  1298. visible := false.
  1299. super remove ]
  1300. !
  1301. removeProgressBar: aProgressBar
  1302. self progressBars remove: aProgressBar ifAbsent: [].
  1303. aProgressBar wrapper asJQuery remove.
  1304. self progressBars ifEmpty: [ self remove ]
  1305. !
  1306. show
  1307. self isVisible ifFalse: [
  1308. visible := true.
  1309. super show ]
  1310. ! !
  1311. !HLProgressWidget methodsFor: 'rendering'!
  1312. renderMainOn: html
  1313. self progressBars do: [ :each |
  1314. html with: each ]
  1315. ! !
  1316. !HLProgressWidget methodsFor: 'testing'!
  1317. hasButtons
  1318. ^ false
  1319. !
  1320. isVisible
  1321. ^ visible ifNil: [ false ]
  1322. ! !
  1323. HLProgressWidget class slots: {#default}!
  1324. !HLProgressWidget class methodsFor: 'accessing'!
  1325. default
  1326. ^ default ifNil: [ default := self new ]
  1327. ! !
  1328. HLModalWidget subclass: #HLTabSelectionWidget
  1329. slots: {#tabs. #tabList. #selectedTab. #selectCallback. #cancelCallback. #confirmCallback}
  1330. package: 'Helios-Core'!
  1331. !HLTabSelectionWidget commentStamp!
  1332. I am a modal window used to select or create tabs.!
  1333. !HLTabSelectionWidget methodsFor: 'accessing'!
  1334. cancelCallback
  1335. ^ cancelCallback ifNil: [ [] ]
  1336. !
  1337. cancelCallback: aBlock
  1338. cancelCallback := aBlock
  1339. !
  1340. confirmCallback
  1341. ^ confirmCallback ifNil: [ [] ]
  1342. !
  1343. confirmCallback: aBlock
  1344. confirmCallback := aBlock
  1345. !
  1346. selectCallback
  1347. ^ selectCallback ifNil: [ [] ]
  1348. !
  1349. selectCallback: aBlock
  1350. selectCallback := aBlock
  1351. !
  1352. selectedTab
  1353. ^ selectedTab
  1354. !
  1355. selectedTab: aTab
  1356. selectedTab := aTab
  1357. !
  1358. tabs
  1359. ^ tabs ifNil: [ #() ]
  1360. !
  1361. tabs: aCollection
  1362. tabs := aCollection
  1363. ! !
  1364. !HLTabSelectionWidget methodsFor: 'actions'!
  1365. cancel
  1366. self remove.
  1367. self cancelCallback value
  1368. !
  1369. confirm
  1370. self remove.
  1371. self confirmCallback value: self selectedTab
  1372. !
  1373. selectTab: aTab
  1374. self selectedTab: aTab.
  1375. self selectCallback value: aTab
  1376. !
  1377. setupKeyBindings
  1378. super setupKeyBindings.
  1379. '.dialog' asJQuery keyup: [ :e |
  1380. e keyCode = String cr asciiValue ifTrue: [ self confirm ] ]
  1381. ! !
  1382. !HLTabSelectionWidget methodsFor: 'rendering'!
  1383. renderButtonsOn: html
  1384. | confirmButton |
  1385. html div
  1386. class: 'buttons';
  1387. with: [
  1388. html button
  1389. class: 'button';
  1390. with: 'Cancel';
  1391. onClick: [ self cancel ].
  1392. confirmButton := html button
  1393. class: 'button default';
  1394. with: 'Select tab';
  1395. onClick: [ self confirm ] ].
  1396. self giveFocusToButton:confirmButton
  1397. !
  1398. renderContentOn: html
  1399. super renderContentOn: html.
  1400. self tabList focus
  1401. !
  1402. renderMainOn: html
  1403. html div
  1404. class: 'title';
  1405. with: 'Tab selection'.
  1406. html with: self tabList
  1407. !
  1408. renderTab: aTab on: html
  1409. html
  1410. span
  1411. class: aTab cssClass;
  1412. with: aTab label
  1413. !
  1414. renderTabsOn: html
  1415. self tabs do: [ :each |
  1416. html li with: [
  1417. html a
  1418. with: [
  1419. self renderTab: each on: html ];
  1420. onClick: [ self selectTab: each ] ] ]
  1421. !
  1422. tabList
  1423. tabList ifNil: [
  1424. tabList := HLTabListWidget new.
  1425. tabList
  1426. callback: [ :tab | self selectTab: tab. tabList focus ];
  1427. selectedItem: self selectedTab;
  1428. items: self tabs ].
  1429. ^ tabList
  1430. ! !
  1431. HLWidget subclass: #HLProgressBarWidget
  1432. slots: {#label. #parent. #workBlock. #collection. #bar}
  1433. package: 'Helios-Core'!
  1434. !HLProgressBarWidget commentStamp!
  1435. I am a widget used to display a progress bar while iterating over a collection.!
  1436. !HLProgressBarWidget methodsFor: 'accessing'!
  1437. collection
  1438. ^ collection
  1439. !
  1440. collection: aCollection
  1441. collection := aCollection
  1442. !
  1443. label
  1444. ^ label
  1445. !
  1446. label: aString
  1447. label := aString
  1448. !
  1449. parent
  1450. ^ parent
  1451. !
  1452. parent: aProgress
  1453. parent := aProgress
  1454. !
  1455. workBlock
  1456. ^ workBlock
  1457. !
  1458. workBlock: aBlock
  1459. workBlock := aBlock
  1460. ! !
  1461. !HLProgressBarWidget methodsFor: 'actions'!
  1462. evaluateAt: anInteger
  1463. self updateProgress: ((anInteger / self collection size) * 100) rounded.
  1464. anInteger <= self collection size
  1465. ifTrue: [
  1466. [
  1467. self workBlock value: (self collection at: anInteger).
  1468. self evaluateAt: anInteger + 1 ] fork ]
  1469. ifFalse: [ [ self remove ] valueWithTimeout: 500 ]
  1470. !
  1471. remove
  1472. self parent removeProgressBar: self
  1473. !
  1474. start
  1475. "Make sure the UI has some time to update itself between each iteration"
  1476. self evaluateAt: 1
  1477. !
  1478. updateProgress: anInteger
  1479. bar asJQuery css: 'width' put: anInteger asString, '%'
  1480. ! !
  1481. !HLProgressBarWidget methodsFor: 'rendering'!
  1482. renderContentOn: html
  1483. html span with: self label.
  1484. html div
  1485. class: 'progress';
  1486. with: [
  1487. bar := html div
  1488. class: 'progress-bar';
  1489. style: 'width: 0%' ]
  1490. ! !
  1491. HLProgressBarWidget class slots: {#default}!
  1492. !HLProgressBarWidget class methodsFor: 'accessing'!
  1493. default
  1494. ^ default ifNil: [ default := self new ]
  1495. ! !
  1496. HLWidget subclass: #HLSpotlightWidget
  1497. slots: {#input}
  1498. package: 'Helios-Core'!
  1499. !HLSpotlightWidget methodsFor: 'accessing'!
  1500. ghostText
  1501. ^ 'Search... (Ctrl+F)'
  1502. !
  1503. inputCompletion
  1504. ^ self manager environment availableClassNames, self manager environment allSelectors
  1505. ! !
  1506. !HLSpotlightWidget methodsFor: 'actions'!
  1507. findMatches: aQueryString andRender: aRenderCallback
  1508. | matches |
  1509. matches := self inputCompletion select: [ :each | each match: aQueryString ].
  1510. aRenderCallback value: matches
  1511. !
  1512. search: aString
  1513. "open a new Browser pointing to aString"
  1514. aString ifNotEmpty: [
  1515. Finder findString: aString ]
  1516. ! !
  1517. !HLSpotlightWidget methodsFor: 'rendering'!
  1518. renderContentOn: html
  1519. input := html input
  1520. class: 'spotlight typeahead';
  1521. placeholder: self ghostText;
  1522. onKeyDown: [ :event |
  1523. event which = 13 ifTrue: [
  1524. self search: input asJQuery val ] ]
  1525. yourself.
  1526. input asJQuery
  1527. typeahead: #{ 'hint' -> true }
  1528. value: #{ 'name' -> 'classesAndSelectors'.
  1529. 'displayKey' -> [ :suggestion | suggestion asString ].
  1530. 'source' -> [ :query :callback | self findMatches: query andRender: callback ]}.
  1531. "use additional datasets for grouping into classes and selectors"
  1532. ! !
  1533. HLWidget subclass: #HLTabWidget
  1534. slots: {#widget. #label. #root}
  1535. package: 'Helios-Core'!
  1536. !HLTabWidget commentStamp!
  1537. I am a widget specialized into building another widget as an Helios tab.
  1538. I should not be used directly, `HLWidget class >> #openAsTab` should be used instead.
  1539. ## Example
  1540. HLWorkspace openAsTab!
  1541. !HLTabWidget methodsFor: 'accessing'!
  1542. activate
  1543. self manager activate: self
  1544. !
  1545. cssClass
  1546. ^ self widget tabClass
  1547. !
  1548. focus
  1549. self widget canHaveFocus ifTrue: [
  1550. self widget focus ]
  1551. !
  1552. label
  1553. ^ label ifNil: [ '' ]
  1554. !
  1555. label: aString
  1556. label := aString
  1557. !
  1558. manager
  1559. ^ HLManager current
  1560. !
  1561. widget
  1562. ^ widget
  1563. !
  1564. widget: aWidget
  1565. widget := aWidget
  1566. ! !
  1567. !HLTabWidget methodsFor: 'actions'!
  1568. add
  1569. self manager addTab: self.
  1570. self observeManager
  1571. !
  1572. hide
  1573. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  1574. !
  1575. observeManager
  1576. self manager announcer
  1577. on: HLTabLabelChanged
  1578. send: #onTabLabelChanged:
  1579. to: self
  1580. !
  1581. registerBindings
  1582. self widget registerBindings
  1583. !
  1584. remove
  1585. self unregister.
  1586. self widget unregister.
  1587. root ifNotNil: [ root asJQuery remove ]
  1588. !
  1589. show
  1590. root
  1591. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  1592. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  1593. !
  1594. unregister
  1595. self manager announcer unsubscribe: self
  1596. ! !
  1597. !HLTabWidget methodsFor: 'reactions'!
  1598. onTabLabelChanged: anAnnouncement
  1599. anAnnouncement widget = self widget ifTrue: [
  1600. self label = anAnnouncement label ifFalse: [
  1601. self label: anAnnouncement label.
  1602. self manager refresh ] ]
  1603. ! !
  1604. !HLTabWidget methodsFor: 'rendering'!
  1605. renderOn: html
  1606. root := html div
  1607. class: 'tab';
  1608. yourself.
  1609. self renderTab
  1610. !
  1611. renderTab
  1612. root contents: [ :html |
  1613. html div
  1614. class: 'amber_box';
  1615. with: [ self widget renderOn: html ] ]
  1616. ! !
  1617. !HLTabWidget methodsFor: 'testing'!
  1618. isActive
  1619. ^ self manager activeTab = self
  1620. ! !
  1621. !HLTabWidget class methodsFor: 'instance creation'!
  1622. on: aWidget labelled: aString
  1623. ^ self new
  1624. widget: aWidget;
  1625. label: aString;
  1626. yourself
  1627. ! !
  1628. HLWidget subclass: #HLTabsWidget
  1629. slots: {#tabs. #activeTab. #history. #selectionDisabled. #spotlight}
  1630. package: 'Helios-Core'!
  1631. !HLTabsWidget methodsFor: 'accessing'!
  1632. activeTab
  1633. ^ activeTab
  1634. !
  1635. history
  1636. ^ history ifNil: [ history := OrderedCollection new ]
  1637. !
  1638. history: aCollection
  1639. history := aCollection
  1640. !
  1641. spotlight
  1642. ^ spotlight ifNil: [ spotlight := HLSpotlightWidget new ]
  1643. !
  1644. tabWidth
  1645. ^ (window asJQuery width - 250) / self tabs size
  1646. !
  1647. tabs
  1648. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  1649. ! !
  1650. !HLTabsWidget methodsFor: 'actions'!
  1651. activate: aTab
  1652. self isSelectionDisabled ifTrue: [ ^ self ].
  1653. (self tabs includes: aTab) ifFalse: [ ^ self ].
  1654. self manager keyBinder flushBindings.
  1655. aTab registerBindings.
  1656. activeTab := aTab.
  1657. self
  1658. refresh;
  1659. addToHistory: aTab;
  1660. show: aTab
  1661. !
  1662. activateNextTab
  1663. | nextTab |
  1664. self tabs ifEmpty: [ ^ self ].
  1665. nextTab := self tabs
  1666. at: (self tabs indexOf: self activeTab) + 1
  1667. ifAbsent: [ self tabs first ].
  1668. self activate: nextTab
  1669. !
  1670. activatePreviousTab
  1671. | previousTab |
  1672. self tabs ifEmpty: [ ^ self ].
  1673. previousTab := self tabs
  1674. at: (self tabs indexOf: self activeTab) - 1
  1675. ifAbsent: [ self tabs last ].
  1676. self activate: previousTab
  1677. !
  1678. addTab: aTab
  1679. self tabs add: aTab.
  1680. self activate: aTab
  1681. !
  1682. addToHistory: aTab
  1683. self removeFromHistory: aTab.
  1684. self history add: aTab
  1685. !
  1686. disableSelection
  1687. selectionDisabled := true
  1688. !
  1689. enableSelection
  1690. selectionDisabled := false
  1691. !
  1692. removeActiveTab
  1693. self removeTab: self activeTab
  1694. !
  1695. removeFromHistory: aTab
  1696. self history: (self history reject: [ :each | each == aTab ])
  1697. !
  1698. removeTab: aTab
  1699. (self tabs includes: aTab) ifFalse: [ ^ self ].
  1700. self removeFromHistory: aTab.
  1701. self tabs remove: aTab.
  1702. self manager keyBinder flushBindings.
  1703. aTab remove.
  1704. self refresh.
  1705. self history ifNotEmpty: [
  1706. self history last activate ]
  1707. !
  1708. removeTabForWidget: aWidget
  1709. self removeTab: (self tabs
  1710. detect: [ :each | each widget = aWidget ]
  1711. ifNone: [ ^ self ])
  1712. !
  1713. updateTabsOrder
  1714. tabs := '.nav-tabs li' asJQuery toArray
  1715. collect: [ :each | each at: 'tab-data' ]
  1716. ! !
  1717. !HLTabsWidget methodsFor: 'private'!
  1718. setupEvents
  1719. 'body' asJQuery keydown: [ :event |
  1720. "ctrl+> and ctrl+<"
  1721. (event ctrlKey and: [ event which = 188 ]) ifTrue: [
  1722. self activatePreviousTab.
  1723. event preventDefault ].
  1724. (event ctrlKey and: [ event which = 190 ]) ifTrue: [
  1725. self activateNextTab.
  1726. event preventDefault ] ]
  1727. ! !
  1728. !HLTabsWidget methodsFor: 'rendering'!
  1729. renderAddOn: html
  1730. html div
  1731. class: 'dropdown new_tab';
  1732. with: [
  1733. html a
  1734. class: 'dropdown-toggle';
  1735. at: 'data-toggle' put: 'dropdown';
  1736. with: [
  1737. (html tag: 'b') class: 'caret' ].
  1738. html ul
  1739. class: 'dropdown-menu';
  1740. with: [
  1741. ((HLWidget withAllSubclasses
  1742. select: [ :each | each canBeOpenAsTab ])
  1743. sorted: [ :a :b | a tabPriority < b tabPriority ])
  1744. do: [ :each |
  1745. html li with: [
  1746. html a
  1747. with: each tabLabel;
  1748. onClick: [ each openAsTab ] ] ] ] ]
  1749. !
  1750. renderContentOn: html
  1751. html div
  1752. class: 'navbar navbar-fixed-top';
  1753. with: [ html div
  1754. class: 'navbar-header';
  1755. at: 'role' put: 'tabpanel';
  1756. with: [ self renderTabsOn: html ] ].
  1757. html with: self spotlight.
  1758. self renderAddOn: html
  1759. !
  1760. renderTab: aTab on: html
  1761. | li |
  1762. li := html li
  1763. style: 'width: ', self tabWidth asString, 'px';
  1764. class: (aTab isActive ifTrue: [ 'tab active' ] ifFalse: [ 'tab inactive' ]);
  1765. with: [
  1766. html a
  1767. with: [
  1768. ((html tag: 'i') class: 'close')
  1769. onClick: [ self removeTab: aTab ].
  1770. html span
  1771. class: aTab cssClass;
  1772. title: aTab label;
  1773. with: aTab label ];
  1774. at: 'role' put: 'tab'];
  1775. onClick: [ aTab activate ].
  1776. li asDomNode at: 'tab-data' put: aTab
  1777. !
  1778. renderTabsOn: html
  1779. | ul |
  1780. ul := html ul
  1781. class: 'nav navbar-nav nav-tabs';
  1782. at: 'role' put: 'tablist';
  1783. with: [
  1784. self tabs do: [ :each |
  1785. self renderTab: each on: html ] ].
  1786. ul asJQuery sortable: #{
  1787. 'containment' -> 'parent'.
  1788. 'start' -> [ self disableSelection ].
  1789. 'stop' -> [ [ self enableSelection] valueWithTimeout: 300 ].
  1790. 'update' -> [ self updateTabsOrder ]
  1791. }
  1792. !
  1793. show: aTab
  1794. self tabs do: [ :each | each hide ].
  1795. aTab show; focus
  1796. ! !
  1797. !HLTabsWidget methodsFor: 'testing'!
  1798. isSelectionDisabled
  1799. ^ selectionDisabled ifNil: [ false ]
  1800. ! !
  1801. HLTabsWidget class slots: {#current}!
  1802. HLWidget subclass: #HLWelcomeWidget
  1803. slots: {}
  1804. package: 'Helios-Core'!
  1805. !HLWelcomeWidget methodsFor: 'accessing'!
  1806. cssClass
  1807. ^ 'welcome'
  1808. ! !
  1809. !HLWelcomeWidget methodsFor: 'actions'!
  1810. openClassBrowser
  1811. HLBrowser openAsTab
  1812. !
  1813. openHelp
  1814. !
  1815. openTestRunner
  1816. HLSUnit openAsTab
  1817. !
  1818. openWorkspace
  1819. HLWorkspace openAsTab
  1820. ! !
  1821. !HLWelcomeWidget methodsFor: 'rendering'!
  1822. renderButtonsOn: html
  1823. html button
  1824. class: 'button';
  1825. with: 'Class Browser';
  1826. onClick: [ self openClassBrowser ].
  1827. html button
  1828. class: 'button';
  1829. with: 'Workspace';
  1830. onClick: [ self openWorkspace ].
  1831. html button
  1832. class: 'button';
  1833. with: 'Test Runner';
  1834. onClick: [ self openTestRunner ].
  1835. "html button
  1836. class: 'button';
  1837. with: 'Help';
  1838. onClick: [ self openHelp ]"
  1839. !
  1840. renderContentOn: html
  1841. self
  1842. renderHelpOn: html;
  1843. renderButtonsOn: html
  1844. !
  1845. renderHelpOn: html
  1846. html h2 with: 'No tools are open'.
  1847. html ul with: [
  1848. html li with: 'Perform actions with ctrl + space'.
  1849. html li with: 'Open one of the common tools:' ]
  1850. ! !