Helios-Core.st 47 KB

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