Helios-Core.st 47 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457
  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: [ :wrappr | wrappr asJQuery
  463. keydown: keyDownBlock;
  464. keyup: 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. |ul|
  673. ul := html ul
  674. class: self listCssClass;
  675. with: [ self renderListOn: html ];
  676. onClick: [ self focus ].
  677. ul asJQuery contextmenu: [ self toggleCommandsMenu. false].
  678. html div class: self buttonsDivCssClass; with: [
  679. self renderButtonsOn: html ].
  680. self setupKeyBindings
  681. !
  682. renderItemLabel: anObject on: html
  683. html with: anObject asString
  684. !
  685. renderItemModel: anObject viewModel: anotherObject on: html
  686. | li |
  687. li := html li.
  688. li asJQuery data: 'item' put: anObject.
  689. li
  690. class: (self listCssClassForItem: anObject);
  691. with: [
  692. html a
  693. with: [
  694. (html tag: 'i') class: (self cssClassForItem: anObject).
  695. self renderItemLabel: anotherObject on: html ];
  696. onClick: [
  697. self reactivateListItem: li asJQuery ] ]
  698. !
  699. renderListOn: html
  700. self items do: [ :each |
  701. self renderItemModel: each viewModel: each on: html ]
  702. ! !
  703. HLListWidget subclass: #HLNavigationListWidget
  704. slots: {#previous. #next}
  705. package: 'Helios-Core'!
  706. !HLNavigationListWidget methodsFor: 'accessing'!
  707. next
  708. ^ next
  709. !
  710. next: aWidget
  711. next := aWidget.
  712. aWidget previous = self ifFalse: [ aWidget previous: self ]
  713. !
  714. previous
  715. ^ previous
  716. !
  717. previous: aWidget
  718. previous := aWidget.
  719. aWidget next = self ifFalse: [ aWidget next: self ]
  720. ! !
  721. !HLNavigationListWidget methodsFor: 'actions'!
  722. nextFocus
  723. self next ifNotNil: [ self next focus ]
  724. !
  725. previousFocus
  726. self previous ifNotNil: [ self previous focus ]
  727. ! !
  728. !HLNavigationListWidget methodsFor: 'events'!
  729. setupKeyBindings
  730. super setupKeyBindings.
  731. self wrapper ifNotNil: [ wrapper onKeyDown: [ :e |
  732. e which = 39 ifTrue: [
  733. self nextFocus ].
  734. e which = 37 ifTrue: [
  735. self previousFocus ] ] ]
  736. ! !
  737. HLNavigationListWidget subclass: #HLToolListWidget
  738. slots: {#model. #commandsMenuElement}
  739. package: 'Helios-Core'!
  740. !HLToolListWidget methodsFor: 'accessing'!
  741. commandCategory
  742. ^ self label
  743. !
  744. label
  745. ^ 'List'
  746. !
  747. menuCommands
  748. "Answer a collection of commands to be put in the cog menu"
  749. ^ ((HLToolCommand concreteClasses
  750. select: [ :each | each isValidFor: self model ])
  751. collect: [ :each | each for: self model ])
  752. select: [ :each |
  753. each category = self commandCategory and: [
  754. each isAction and: [ each isActive ] ] ]
  755. !
  756. model
  757. ^ model
  758. !
  759. model: aBrowserModel
  760. model := aBrowserModel.
  761. self
  762. observeSystem;
  763. observeModel
  764. !
  765. selectedItem: anItem
  766. "Selection changed, update the cog menu"
  767. super selectedItem: anItem.
  768. self updateMenu
  769. ! !
  770. !HLToolListWidget methodsFor: 'actions'!
  771. activateListItem: anItem
  772. self model withChangesDo: [ super activateListItem: anItem ]
  773. !
  774. activateNextListItem
  775. self model withChangesDo: [ super activateNextListItem ]
  776. !
  777. activatePreviousListItem
  778. self model withChangesDo: [ super activatePreviousListItem ]
  779. !
  780. observeModel
  781. !
  782. observeSystem
  783. !
  784. reactivateListItem: anItem
  785. self model withChangesDo: [ super reactivateListItem: anItem ]
  786. !
  787. toggleCommandsMenu
  788. commandsMenuElement asJQuery dropdown: 'toggle'
  789. !
  790. unregister
  791. super unregister.
  792. self model announcer unsubscribe: self.
  793. self model systemAnnouncer unsubscribe: self
  794. ! !
  795. !HLToolListWidget methodsFor: 'rendering'!
  796. renderContentOn: html
  797. self renderHeadOn: html.
  798. super renderContentOn: html
  799. !
  800. renderHeadOn: html
  801. html div
  802. class: 'list-label';
  803. with: [
  804. html with: self label.
  805. self renderMenuOn: html ]
  806. !
  807. renderMenuOn: html
  808. | commands |
  809. commands := self menuCommands.
  810. commands ifEmpty: [ ^ self ].
  811. html div
  812. class: 'btn-group cog';
  813. with: [
  814. commandsMenuElement := html a
  815. class: 'btn btn-default dropdown-toggle';
  816. at: 'data-toggle' put: 'dropdown';
  817. with: [ (html tag: 'i') class: 'glyphicon glyphicon-chevron-down' ].
  818. html ul
  819. class: 'dropdown-menu pull-right';
  820. with: [
  821. commands do: [ :each |
  822. html li with: [ html a
  823. with: each menuLabel;
  824. onClick: [ self execute: each ] ] ] ] ]
  825. ! !
  826. !HLToolListWidget methodsFor: 'updating'!
  827. updateMenu
  828. (self wrapper asJQuery find: '.cog') remove.
  829. [ :html | self renderMenuOn: html ]
  830. appendToJQuery: (self wrapper asJQuery find: '.list-label')
  831. ! !
  832. !HLToolListWidget class methodsFor: 'instance creation'!
  833. on: aModel
  834. ^ self new
  835. model: aModel;
  836. yourself
  837. ! !
  838. HLListWidget subclass: #HLTabListWidget
  839. slots: {#callback}
  840. package: 'Helios-Core'!
  841. !HLTabListWidget commentStamp!
  842. I am a widget used to display a list of helios tabs.
  843. When a tab is selected, `callback` is evaluated with the selected tab as argument.!
  844. !HLTabListWidget methodsFor: 'accessing'!
  845. callback
  846. ^ callback ifNil: [ [] ]
  847. !
  848. callback: aBlock
  849. callback := aBlock
  850. ! !
  851. !HLTabListWidget methodsFor: 'actions'!
  852. selectItem: aTab
  853. super selectItem: aTab.
  854. self callback value: aTab
  855. ! !
  856. !HLTabListWidget methodsFor: 'rendering'!
  857. renderItemLabel: aTab on: html
  858. html span
  859. class: aTab cssClass;
  860. with: aTab label
  861. ! !
  862. HLWidget subclass: #HLInformationWidget
  863. slots: {#informationString}
  864. package: 'Helios-Core'!
  865. !HLInformationWidget commentStamp!
  866. I display an information dialog.
  867. ## API
  868. `HLWidget >> #inform:` is a convenience method for creating information dialogs.!
  869. !HLInformationWidget methodsFor: 'accessing'!
  870. informationString
  871. ^ informationString ifNil: [ '' ]
  872. !
  873. informationString: anObject
  874. informationString := anObject
  875. ! !
  876. !HLInformationWidget methodsFor: 'actions'!
  877. remove
  878. [
  879. self wrapper asJQuery fadeOut: 100.
  880. [ self wrapper asJQuery remove ]
  881. valueWithTimeout: 400.
  882. ]
  883. valueWithTimeout: 1500
  884. !
  885. show
  886. self appendToJQuery: 'body' asJQuery
  887. ! !
  888. !HLInformationWidget methodsFor: 'rendering'!
  889. renderContentOn: html
  890. html div
  891. class: 'growl';
  892. with: self informationString.
  893. self remove
  894. ! !
  895. HLWidget subclass: #HLManager
  896. slots: {#tabsWidget. #environment. #history. #announcer. #rendered}
  897. package: 'Helios-Core'!
  898. !HLManager commentStamp!
  899. HLManager is the entry point Class of Helios.
  900. Its `singleton` instance is created on startup, and rendered on body.!
  901. !HLManager methodsFor: 'accessing'!
  902. activeTab
  903. ^ self tabsWidget activeTab
  904. !
  905. announcer
  906. ^ announcer ifNil: [ announcer := Announcer new ]
  907. !
  908. environment
  909. "The default environment used by all Helios objects"
  910. ^ environment ifNil: [ environment := self defaultEnvironment ]
  911. !
  912. environment: anEnvironment
  913. environment := anEnvironment
  914. !
  915. history
  916. ^ history ifNil: [ history := OrderedCollection new ]
  917. !
  918. history: aCollection
  919. history := aCollection
  920. !
  921. keyBinder
  922. ^ HLKeyBinder current
  923. !
  924. setEditorTheme: aTheme
  925. 'helios.editorTheme' asSetting value: aTheme
  926. !
  927. setTheme: aTheme
  928. | currentTheme |
  929. currentTheme := 'helios.theme' asSettingIfAbsent: 'default'.
  930. 'body' asJQuery
  931. removeClass: currentTheme value;
  932. addClass: aTheme.
  933. 'helios.theme' asSetting value: aTheme
  934. !
  935. tabWidth
  936. ^ (window asJQuery width - 90) / self tabs size
  937. !
  938. tabs
  939. ^ self tabsWidget tabs
  940. !
  941. tabsWidget
  942. ^ tabsWidget ifNil: [ tabsWidget := HLTabsWidget new ]
  943. ! !
  944. !HLManager methodsFor: 'actions'!
  945. activate: aTab
  946. self tabsWidget activate: aTab
  947. !
  948. addTab: aTab
  949. self tabsWidget addTab: aTab
  950. !
  951. confirm: aString ifFalse: aBlock
  952. self
  953. confirm: aString
  954. ifTrue: []
  955. ifFalse: aBlock
  956. !
  957. confirm: aString ifTrue: aBlock
  958. self
  959. confirm: aString
  960. ifTrue: aBlock
  961. ifFalse: []
  962. !
  963. confirm: aString ifTrue: aBlock ifFalse: anotherBlock
  964. HLConfirmationWidget new
  965. confirmationString: aString;
  966. actionBlock: aBlock;
  967. cancelBlock: anotherBlock;
  968. show
  969. !
  970. handleLossOfEnvironmentWithParent: parent
  971. parent at: 'onunload' put: [
  972. self removeBeforeUnloadMessage.
  973. window close ]
  974. !
  975. inform: aString
  976. HLInformationWidget new
  977. informationString: aString;
  978. show
  979. !
  980. removeActiveTab
  981. self tabsWidget removeActiveTab
  982. !
  983. removeBeforeUnloadMessage
  984. <inlineJS: 'window.onbeforeunload = null'>
  985. !
  986. removeTabForWidget: aWidget
  987. self tabsWidget removeTabForWidget: aWidget
  988. !
  989. request: aString do: aBlock
  990. self
  991. request: aString
  992. value: ''
  993. do: aBlock
  994. !
  995. request: aString value: valueString do: aBlock
  996. HLRequestWidget new
  997. confirmationString: aString;
  998. actionBlock: aBlock;
  999. value: valueString;
  1000. show
  1001. ! !
  1002. !HLManager methodsFor: 'defaults'!
  1003. defaultEnvironment
  1004. "If helios is loaded from within a frame, answer the parent window environment"
  1005. | parent parentSmalltalkGlobals |
  1006. parent := window opener ifNil: [ window parent ].
  1007. parent ifNil: [ ^ Environment new ].
  1008. parentSmalltalkGlobals := ((parent at: 'requirejs') value: 'amber/boot') at: 'globals'.
  1009. parentSmalltalkGlobals ifNil: [ ^ Environment new ].
  1010. self handleLossOfEnvironmentWithParent: parent.
  1011. ^ (parentSmalltalkGlobals at: 'Environment') new
  1012. ! !
  1013. !HLManager methodsFor: 'initialization'!
  1014. initialize
  1015. super initialize.
  1016. rendered := false
  1017. !
  1018. setup
  1019. self
  1020. registerServices;
  1021. setupEvents.
  1022. self keyBinder setupEvents.
  1023. self tabsWidget setupEvents.
  1024. self setupTheme.
  1025. '#helper' asJQuery fadeOut
  1026. ! !
  1027. !HLManager methodsFor: 'private'!
  1028. registerServices
  1029. self
  1030. registerInspector;
  1031. registerErrorHandler;
  1032. registerProgressHandler;
  1033. registerTranscript;
  1034. registerFinder
  1035. !
  1036. setupEvents
  1037. 'body' asJQuery keydown: [ :event |
  1038. "On ctrl keydown, adds a 'navigation' css class to <body>
  1039. for the CodeMirror navigation links. See `HLCodeWidget`."
  1040. event ctrlKey ifTrue: [
  1041. 'body' asJQuery addClass: 'navigation' ] ].
  1042. 'body' asJQuery keyup: [ :event |
  1043. 'body' asJQuery removeClass: 'navigation' ].
  1044. window asJQuery resize: [ :event |
  1045. self refresh ]
  1046. !
  1047. setupTheme
  1048. "self
  1049. setTheme: 'niflheim';
  1050. setEditorTheme: 'niflheim'."
  1051. self
  1052. setTheme: 'default';
  1053. setEditorTheme: 'default'.
  1054. ! !
  1055. !HLManager methodsFor: 'rendering'!
  1056. renderContentOn: html
  1057. html with: self tabsWidget.
  1058. html with: HLWelcomeWidget new.
  1059. self renderDefaultTabs.
  1060. rendered := true
  1061. !
  1062. renderDefaultTabs
  1063. rendered ifFalse: [
  1064. HLWorkspace openAsTab.
  1065. HLBrowser openAsTab ]
  1066. ! !
  1067. !HLManager methodsFor: 'services'!
  1068. registerErrorHandler
  1069. | handler |
  1070. handler := HLErrorHandler new.
  1071. self environment registerErrorHandler: handler.
  1072. ErrorHandler register: handler
  1073. !
  1074. registerFinder
  1075. self environment registerFinder: HLFinder new.
  1076. Finder register: HLFinder new
  1077. !
  1078. registerInspector
  1079. self environment registerInspector: HLInspector.
  1080. Inspector register: HLInspector
  1081. !
  1082. registerProgressHandler
  1083. self environment registerProgressHandler: HLProgressHandler new.
  1084. ProgressHandler register: HLProgressHandler new
  1085. !
  1086. registerTranscript
  1087. self environment registerTranscript: HLTranscriptHandler
  1088. ! !
  1089. HLManager class slots: {#current}!
  1090. !HLManager class methodsFor: 'accessing'!
  1091. current
  1092. ^ current ifNil: [ current := self basicNew initialize ]
  1093. ! !
  1094. !HLManager class methodsFor: 'initialization'!
  1095. setup
  1096. self current
  1097. setup;
  1098. appendToJQuery: 'body' asJQuery.
  1099. ('helios.confirmOnExit' settingValueIfAbsent: true) ifTrue: [
  1100. window onbeforeunload: [ 'Do you want to close Amber? All uncommitted changes will be lost.' ] ]
  1101. ! !
  1102. !HLManager class methodsFor: 'instance creation'!
  1103. new
  1104. "Use current instead"
  1105. self shouldNotImplement
  1106. ! !
  1107. HLWidget subclass: #HLModalWidget
  1108. slots: {}
  1109. package: 'Helios-Core'!
  1110. !HLModalWidget commentStamp!
  1111. I implement an abstract modal widget.!
  1112. !HLModalWidget methodsFor: 'actions'!
  1113. remove
  1114. '.dialog' asJQuery removeClass: 'active'.
  1115. HLModalWidget current: nil.
  1116. '#overlay' asJQuery remove.
  1117. [
  1118. wrapper asJQuery remove
  1119. ] valueWithTimeout: 300
  1120. !
  1121. show
  1122. HLModalWidget current ifNotNil: [ :old | old remove ].
  1123. HLModalWidget current: self.
  1124. self appendToJQuery: 'body' asJQuery
  1125. ! !
  1126. !HLModalWidget methodsFor: 'private'!
  1127. giveFocusToButton: aButton
  1128. aButton asJQuery focus
  1129. ! !
  1130. !HLModalWidget methodsFor: 'rendering'!
  1131. hasButtons
  1132. ^ true
  1133. !
  1134. renderButtonsOn: html
  1135. !
  1136. renderContentOn: html
  1137. | confirmButton |
  1138. html div id: 'overlay'.
  1139. html div
  1140. class: 'dialog ', self cssClass;
  1141. with: [
  1142. self renderMainOn: html.
  1143. self hasButtons ifTrue: [
  1144. self renderButtonsOn: html ] ].
  1145. '.dialog' asJQuery addClass: 'active'.
  1146. self setupKeyBindings
  1147. !
  1148. renderMainOn: html
  1149. !
  1150. setupKeyBindings
  1151. '.dialog' asJQuery keyup: [ :e |
  1152. e keyCode = String esc asciiValue ifTrue: [ self cancel ] ]
  1153. ! !
  1154. HLModalWidget class slots: {#current}!
  1155. !HLModalWidget class methodsFor: 'accessing'!
  1156. current
  1157. ^ current
  1158. !
  1159. current: anHLModelWidget
  1160. current := anHLModelWidget
  1161. ! !
  1162. HLModalWidget subclass: #HLConfirmationWidget
  1163. slots: {#cancelButtonLabel. #confirmButtonLabel. #confirmationString. #actionBlock. #cancelBlock}
  1164. package: 'Helios-Core'!
  1165. !HLConfirmationWidget commentStamp!
  1166. I display confirmation dialog.
  1167. ## API
  1168. HLWidget contains convenience methods like `HLWidget >> #confirm:ifTrue:` for creating confirmation dialogs.!
  1169. !HLConfirmationWidget methodsFor: 'accessing'!
  1170. actionBlock
  1171. ^ actionBlock ifNil: [ [] ]
  1172. !
  1173. actionBlock: aBlock
  1174. actionBlock := aBlock
  1175. !
  1176. cancelBlock
  1177. ^ cancelBlock ifNil: [ [] ]
  1178. !
  1179. cancelBlock: aBlock
  1180. cancelBlock := aBlock
  1181. !
  1182. cancelButtonLabel
  1183. ^ cancelButtonLabel ifNil: [ 'Cancel' ]
  1184. !
  1185. cancelButtonLabel: aString
  1186. ^ cancelButtonLabel := aString
  1187. !
  1188. confirmButtonLabel
  1189. ^ confirmButtonLabel ifNil: [ 'Confirm' ]
  1190. !
  1191. confirmButtonLabel: aString
  1192. ^ confirmButtonLabel := aString
  1193. !
  1194. confirmationString
  1195. ^ confirmationString ifNil: [ 'Confirm' ]
  1196. !
  1197. confirmationString: aString
  1198. confirmationString := aString
  1199. ! !
  1200. !HLConfirmationWidget methodsFor: 'actions'!
  1201. cancel
  1202. self cancelBlock value.
  1203. self remove
  1204. !
  1205. confirm
  1206. self remove.
  1207. self actionBlock value
  1208. ! !
  1209. !HLConfirmationWidget methodsFor: 'rendering'!
  1210. renderButtonsOn: html
  1211. | confirmButton |
  1212. html div
  1213. class: 'buttons';
  1214. with: [
  1215. html button
  1216. class: 'button';
  1217. with: self cancelButtonLabel;
  1218. onClick: [ self cancel ].
  1219. confirmButton := html button
  1220. class: 'button default';
  1221. with: self confirmButtonLabel;
  1222. onClick: [ self confirm ] ].
  1223. self giveFocusToButton:confirmButton
  1224. !
  1225. renderMainOn: html
  1226. html span
  1227. class: 'head';
  1228. with: self confirmationString
  1229. ! !
  1230. HLConfirmationWidget subclass: #HLRequestWidget
  1231. slots: {#input. #multiline. #value}
  1232. package: 'Helios-Core'!
  1233. !HLRequestWidget commentStamp!
  1234. I display a modal window requesting user input.
  1235. ## API
  1236. `HLWidget >> #request:do:` and `#request:value:do:` are convenience methods for creating modal request dialogs.!
  1237. !HLRequestWidget methodsFor: 'accessing'!
  1238. beMultiline
  1239. multiline := true
  1240. !
  1241. beSingleline
  1242. multiline := false
  1243. !
  1244. cssClass
  1245. ^ 'large'
  1246. !
  1247. value
  1248. ^ value ifNil: [ '' ]
  1249. !
  1250. value: aString
  1251. value := aString
  1252. ! !
  1253. !HLRequestWidget methodsFor: 'actions'!
  1254. confirm
  1255. | val |
  1256. val := input asJQuery val.
  1257. self remove.
  1258. self actionBlock value: val
  1259. ! !
  1260. !HLRequestWidget methodsFor: 'private'!
  1261. giveFocusToButton: aButton
  1262. ! !
  1263. !HLRequestWidget methodsFor: 'rendering'!
  1264. renderMainOn: html
  1265. super renderMainOn: html.
  1266. self isMultiline
  1267. ifTrue: [ input := html textarea ]
  1268. ifFalse: [ input := html input
  1269. type: 'text';
  1270. onKeyDown: [ :event |
  1271. event keyCode = 13 ifTrue: [
  1272. self confirm ] ];
  1273. yourself ].
  1274. input asJQuery
  1275. val: self value;
  1276. focus
  1277. ! !
  1278. !HLRequestWidget methodsFor: 'testing'!
  1279. isMultiline
  1280. ^ multiline ifNil: [ true ]
  1281. ! !
  1282. HLModalWidget subclass: #HLProgressWidget
  1283. slots: {#progressBars. #visible}
  1284. package: 'Helios-Core'!
  1285. !HLProgressWidget commentStamp!
  1286. I am a widget used to display progress modal dialogs.
  1287. My default instance is accessed with `HLProgressWidget class >> #default`.
  1288. See `HLProgressHandler` for usage.!
  1289. !HLProgressWidget methodsFor: 'accessing'!
  1290. progressBars
  1291. ^ progressBars ifNil: [ progressBars := OrderedCollection new ]
  1292. ! !
  1293. !HLProgressWidget methodsFor: 'actions'!
  1294. addProgressBar: aProgressBar
  1295. self show.
  1296. self progressBars add: aProgressBar.
  1297. aProgressBar appendToJQuery: (self wrapper asJQuery find: '.dialog')
  1298. !
  1299. do: aBlock on: aCollection displaying: aString
  1300. | progressBar |
  1301. progressBar := HLProgressBarWidget new
  1302. parent: self;
  1303. label: aString;
  1304. workBlock: aBlock;
  1305. collection: aCollection;
  1306. yourself.
  1307. self addProgressBar: progressBar.
  1308. progressBar start
  1309. !
  1310. flush
  1311. self progressBars do: [ :each |
  1312. self removeProgressBar: each ]
  1313. !
  1314. remove
  1315. self isVisible ifTrue: [
  1316. visible := false.
  1317. super remove ]
  1318. !
  1319. removeProgressBar: aProgressBar
  1320. self progressBars remove: aProgressBar ifAbsent: [].
  1321. aProgressBar wrapper asJQuery remove.
  1322. self progressBars ifEmpty: [ self remove ]
  1323. !
  1324. show
  1325. self isVisible ifFalse: [
  1326. visible := true.
  1327. super show ]
  1328. ! !
  1329. !HLProgressWidget methodsFor: 'rendering'!
  1330. renderMainOn: html
  1331. self progressBars do: [ :each |
  1332. html with: each ]
  1333. ! !
  1334. !HLProgressWidget methodsFor: 'testing'!
  1335. hasButtons
  1336. ^ false
  1337. !
  1338. isVisible
  1339. ^ visible ifNil: [ false ]
  1340. ! !
  1341. HLProgressWidget class slots: {#default}!
  1342. !HLProgressWidget class methodsFor: 'accessing'!
  1343. default
  1344. ^ default ifNil: [ default := self new ]
  1345. ! !
  1346. HLModalWidget subclass: #HLTabSelectionWidget
  1347. slots: {#tabs. #tabList. #selectedTab. #selectCallback. #cancelCallback. #confirmCallback}
  1348. package: 'Helios-Core'!
  1349. !HLTabSelectionWidget commentStamp!
  1350. I am a modal window used to select or create tabs.!
  1351. !HLTabSelectionWidget methodsFor: 'accessing'!
  1352. cancelCallback
  1353. ^ cancelCallback ifNil: [ [] ]
  1354. !
  1355. cancelCallback: aBlock
  1356. cancelCallback := aBlock
  1357. !
  1358. confirmCallback
  1359. ^ confirmCallback ifNil: [ [] ]
  1360. !
  1361. confirmCallback: aBlock
  1362. confirmCallback := aBlock
  1363. !
  1364. selectCallback
  1365. ^ selectCallback ifNil: [ [] ]
  1366. !
  1367. selectCallback: aBlock
  1368. selectCallback := aBlock
  1369. !
  1370. selectedTab
  1371. ^ selectedTab
  1372. !
  1373. selectedTab: aTab
  1374. selectedTab := aTab
  1375. !
  1376. tabs
  1377. ^ tabs ifNil: [ #() ]
  1378. !
  1379. tabs: aCollection
  1380. tabs := aCollection
  1381. ! !
  1382. !HLTabSelectionWidget methodsFor: 'actions'!
  1383. cancel
  1384. self remove.
  1385. self cancelCallback value
  1386. !
  1387. confirm
  1388. self remove.
  1389. self confirmCallback value: self selectedTab
  1390. !
  1391. selectTab: aTab
  1392. self selectedTab: aTab.
  1393. self selectCallback value: aTab
  1394. !
  1395. setupKeyBindings
  1396. super setupKeyBindings.
  1397. '.dialog' asJQuery keyup: [ :e |
  1398. e keyCode = String cr asciiValue ifTrue: [ self confirm ] ]
  1399. ! !
  1400. !HLTabSelectionWidget methodsFor: 'rendering'!
  1401. renderButtonsOn: html
  1402. | confirmButton |
  1403. html div
  1404. class: 'buttons';
  1405. with: [
  1406. html button
  1407. class: 'button';
  1408. with: 'Cancel';
  1409. onClick: [ self cancel ].
  1410. confirmButton := html button
  1411. class: 'button default';
  1412. with: 'Select tab';
  1413. onClick: [ self confirm ] ].
  1414. self giveFocusToButton:confirmButton
  1415. !
  1416. renderContentOn: html
  1417. super renderContentOn: html.
  1418. self tabList focus
  1419. !
  1420. renderMainOn: html
  1421. html div
  1422. class: 'title';
  1423. with: 'Tab selection'.
  1424. html with: self tabList
  1425. !
  1426. renderTab: aTab on: html
  1427. html
  1428. span
  1429. class: aTab cssClass;
  1430. with: aTab label
  1431. !
  1432. renderTabsOn: html
  1433. self tabs do: [ :each |
  1434. html li with: [
  1435. html a
  1436. with: [
  1437. self renderTab: each on: html ];
  1438. onClick: [ self selectTab: each ] ] ]
  1439. !
  1440. tabList
  1441. tabList ifNil: [
  1442. tabList := HLTabListWidget new.
  1443. tabList
  1444. callback: [ :tab | self selectTab: tab. tabList focus ];
  1445. selectedItem: self selectedTab;
  1446. items: self tabs ].
  1447. ^ tabList
  1448. ! !
  1449. HLWidget subclass: #HLProgressBarWidget
  1450. slots: {#label. #parent. #workBlock. #collection. #bar}
  1451. package: 'Helios-Core'!
  1452. !HLProgressBarWidget commentStamp!
  1453. I am a widget used to display a progress bar while iterating over a collection.!
  1454. !HLProgressBarWidget methodsFor: 'accessing'!
  1455. collection
  1456. ^ collection
  1457. !
  1458. collection: aCollection
  1459. collection := aCollection
  1460. !
  1461. label
  1462. ^ label
  1463. !
  1464. label: aString
  1465. label := aString
  1466. !
  1467. parent
  1468. ^ parent
  1469. !
  1470. parent: aProgress
  1471. parent := aProgress
  1472. !
  1473. workBlock
  1474. ^ workBlock
  1475. !
  1476. workBlock: aBlock
  1477. workBlock := aBlock
  1478. ! !
  1479. !HLProgressBarWidget methodsFor: 'actions'!
  1480. evaluateAt: anInteger
  1481. self updateProgress: ((anInteger / self collection size) * 100) rounded.
  1482. anInteger <= self collection size
  1483. ifTrue: [
  1484. [
  1485. self workBlock value: (self collection at: anInteger).
  1486. self evaluateAt: anInteger + 1 ] fork ]
  1487. ifFalse: [ [ self remove ] valueWithTimeout: 500 ]
  1488. !
  1489. remove
  1490. self parent removeProgressBar: self
  1491. !
  1492. start
  1493. "Make sure the UI has some time to update itself between each iteration"
  1494. self evaluateAt: 1
  1495. !
  1496. updateProgress: anInteger
  1497. bar asJQuery css: 'width' put: anInteger asString, '%'
  1498. ! !
  1499. !HLProgressBarWidget methodsFor: 'rendering'!
  1500. renderContentOn: html
  1501. html span with: self label.
  1502. html div
  1503. class: 'progress';
  1504. with: [
  1505. bar := html div
  1506. class: 'progress-bar';
  1507. style: 'width: 0%' ]
  1508. ! !
  1509. HLProgressBarWidget class slots: {#default}!
  1510. !HLProgressBarWidget class methodsFor: 'accessing'!
  1511. default
  1512. ^ default ifNil: [ default := self new ]
  1513. ! !
  1514. HLWidget subclass: #HLSpotlightWidget
  1515. slots: {#input}
  1516. package: 'Helios-Core'!
  1517. !HLSpotlightWidget methodsFor: 'accessing'!
  1518. ghostText
  1519. ^ 'Search... (Ctrl+F)'
  1520. !
  1521. inputCompletion
  1522. ^ self manager environment availableClassNames, self manager environment allSelectors
  1523. ! !
  1524. !HLSpotlightWidget methodsFor: 'actions'!
  1525. findMatches: aQueryString andRender: aRenderCallback
  1526. | matches |
  1527. matches := self inputCompletion select: [ :each | each match: aQueryString ].
  1528. aRenderCallback value: matches
  1529. !
  1530. search: aString
  1531. "open a new Browser pointing to aString"
  1532. aString ifNotEmpty: [
  1533. Finder findString: aString ]
  1534. ! !
  1535. !HLSpotlightWidget methodsFor: 'rendering'!
  1536. renderContentOn: html
  1537. input := html input
  1538. class: 'spotlight typeahead';
  1539. placeholder: self ghostText;
  1540. onKeyDown: [ :event |
  1541. event which = 13 ifTrue: [
  1542. self search: input asJQuery val ] ]
  1543. yourself.
  1544. input asJQuery
  1545. typeahead: #{ 'hint' -> true }
  1546. value: #{ 'name' -> 'classesAndSelectors'.
  1547. 'displayKey' -> [ :suggestion | suggestion asString ].
  1548. 'source' -> [ :query :callback | self findMatches: query andRender: callback ]}.
  1549. "use additional datasets for grouping into classes and selectors"
  1550. ! !
  1551. HLWidget subclass: #HLTabWidget
  1552. slots: {#widget. #label. #root}
  1553. package: 'Helios-Core'!
  1554. !HLTabWidget commentStamp!
  1555. I am a widget specialized into building another widget as an Helios tab.
  1556. I should not be used directly, `HLWidget class >> #openAsTab` should be used instead.
  1557. ## Example
  1558. HLWorkspace openAsTab!
  1559. !HLTabWidget methodsFor: 'accessing'!
  1560. activate
  1561. self manager activate: self
  1562. !
  1563. cssClass
  1564. ^ self widget tabClass
  1565. !
  1566. focus
  1567. self widget canHaveFocus ifTrue: [
  1568. self widget focus ]
  1569. !
  1570. label
  1571. ^ label ifNil: [ '' ]
  1572. !
  1573. label: aString
  1574. label := aString
  1575. !
  1576. manager
  1577. ^ HLManager current
  1578. !
  1579. widget
  1580. ^ widget
  1581. !
  1582. widget: aWidget
  1583. widget := aWidget
  1584. ! !
  1585. !HLTabWidget methodsFor: 'actions'!
  1586. add
  1587. self manager addTab: self.
  1588. self observeManager
  1589. !
  1590. hide
  1591. root ifNotNil: [ root asJQuery css: 'visibility' put: 'hidden' ]
  1592. !
  1593. observeManager
  1594. self manager announcer
  1595. on: HLTabLabelChanged
  1596. send: #onTabLabelChanged:
  1597. to: self
  1598. !
  1599. registerBindings
  1600. self widget registerBindings
  1601. !
  1602. remove
  1603. self unregister.
  1604. self widget unregister.
  1605. root ifNotNil: [ root asJQuery remove ]
  1606. !
  1607. show
  1608. root
  1609. ifNil: [ self appendToJQuery: 'body' asJQuery ]
  1610. ifNotNil: [ root asJQuery css: 'visibility' put: 'visible' ]
  1611. !
  1612. unregister
  1613. self manager announcer unsubscribe: self
  1614. ! !
  1615. !HLTabWidget methodsFor: 'reactions'!
  1616. onTabLabelChanged: anAnnouncement
  1617. anAnnouncement widget = self widget ifTrue: [
  1618. self label = anAnnouncement label ifFalse: [
  1619. self label: anAnnouncement label.
  1620. self manager refresh ] ]
  1621. ! !
  1622. !HLTabWidget methodsFor: 'rendering'!
  1623. renderOn: html
  1624. root := html div
  1625. class: 'tab';
  1626. yourself.
  1627. self renderTab
  1628. !
  1629. renderTab
  1630. root contents: [ :html |
  1631. html div
  1632. class: 'amber_box';
  1633. with: [ self widget renderOn: html ] ]
  1634. ! !
  1635. !HLTabWidget methodsFor: 'testing'!
  1636. isActive
  1637. ^ self manager activeTab = self
  1638. ! !
  1639. !HLTabWidget class methodsFor: 'instance creation'!
  1640. on: aWidget labelled: aString
  1641. ^ self new
  1642. widget: aWidget;
  1643. label: aString;
  1644. yourself
  1645. ! !
  1646. HLWidget subclass: #HLTabsWidget
  1647. slots: {#tabs. #activeTab. #history. #selectionDisabled. #spotlight}
  1648. package: 'Helios-Core'!
  1649. !HLTabsWidget methodsFor: 'accessing'!
  1650. activeTab
  1651. ^ activeTab
  1652. !
  1653. history
  1654. ^ history ifNil: [ history := OrderedCollection new ]
  1655. !
  1656. history: aCollection
  1657. history := aCollection
  1658. !
  1659. spotlight
  1660. ^ spotlight ifNil: [ spotlight := HLSpotlightWidget new ]
  1661. !
  1662. tabWidth
  1663. ^ (window asJQuery width - 250) / self tabs size
  1664. !
  1665. tabs
  1666. ^ tabs ifNil: [ tabs := OrderedCollection new ]
  1667. ! !
  1668. !HLTabsWidget methodsFor: 'actions'!
  1669. activate: aTab
  1670. self isSelectionDisabled ifTrue: [ ^ self ].
  1671. (self tabs includes: aTab) ifFalse: [ ^ self ].
  1672. self manager keyBinder flushBindings.
  1673. aTab registerBindings.
  1674. activeTab := aTab.
  1675. self
  1676. refresh;
  1677. addToHistory: aTab;
  1678. show: aTab
  1679. !
  1680. activateNextTab
  1681. | nextTab |
  1682. self tabs ifEmpty: [ ^ self ].
  1683. nextTab := self tabs
  1684. at: (self tabs indexOf: self activeTab) + 1
  1685. ifAbsent: [ self tabs first ].
  1686. self activate: nextTab
  1687. !
  1688. activatePreviousTab
  1689. | previousTab |
  1690. self tabs ifEmpty: [ ^ self ].
  1691. previousTab := self tabs
  1692. at: (self tabs indexOf: self activeTab) - 1
  1693. ifAbsent: [ self tabs last ].
  1694. self activate: previousTab
  1695. !
  1696. addTab: aTab
  1697. self tabs add: aTab.
  1698. self activate: aTab
  1699. !
  1700. addToHistory: aTab
  1701. self removeFromHistory: aTab.
  1702. self history add: aTab
  1703. !
  1704. disableSelection
  1705. selectionDisabled := true
  1706. !
  1707. enableSelection
  1708. selectionDisabled := false
  1709. !
  1710. removeActiveTab
  1711. self removeTab: self activeTab
  1712. !
  1713. removeFromHistory: aTab
  1714. self history: (self history reject: [ :each | each == aTab ])
  1715. !
  1716. removeTab: aTab
  1717. (self tabs includes: aTab) ifFalse: [ ^ self ].
  1718. self removeFromHistory: aTab.
  1719. self tabs remove: aTab.
  1720. self manager keyBinder flushBindings.
  1721. aTab remove.
  1722. self refresh.
  1723. self history ifNotEmpty: [
  1724. self history last activate ]
  1725. !
  1726. removeTabForWidget: aWidget
  1727. self removeTab: (self tabs
  1728. detect: [ :each | each widget = aWidget ]
  1729. ifNone: [ ^ self ])
  1730. !
  1731. updateTabsOrder
  1732. tabs := '.nav-tabs li' asJQuery toArray
  1733. collect: [ :each | each at: 'tab-data' ]
  1734. ! !
  1735. !HLTabsWidget methodsFor: 'private'!
  1736. setupEvents
  1737. 'body' asJQuery keydown: [ :event |
  1738. "ctrl+> and ctrl+<"
  1739. (event ctrlKey and: [ event which = 188 ]) ifTrue: [
  1740. self activatePreviousTab.
  1741. event preventDefault ].
  1742. (event ctrlKey and: [ event which = 190 ]) ifTrue: [
  1743. self activateNextTab.
  1744. event preventDefault ] ]
  1745. ! !
  1746. !HLTabsWidget methodsFor: 'rendering'!
  1747. renderAddOn: html
  1748. html div
  1749. class: 'dropdown new_tab';
  1750. with: [
  1751. html a
  1752. class: 'dropdown-toggle';
  1753. at: 'data-toggle' put: 'dropdown';
  1754. with: [
  1755. (html tag: 'b') class: 'caret' ].
  1756. html ul
  1757. class: 'dropdown-menu';
  1758. with: [
  1759. ((HLWidget withAllSubclasses
  1760. select: [ :each | each canBeOpenAsTab ])
  1761. sorted: [ :a :b | a tabPriority < b tabPriority ])
  1762. do: [ :each |
  1763. html li with: [
  1764. html a
  1765. with: each tabLabel;
  1766. onClick: [ each openAsTab ] ] ] ] ]
  1767. !
  1768. renderContentOn: html
  1769. html div
  1770. class: 'navbar navbar-fixed-top';
  1771. with: [ html div
  1772. class: 'navbar-header';
  1773. at: 'role' put: 'tabpanel';
  1774. with: [ self renderTabsOn: html ] ].
  1775. html with: self spotlight.
  1776. self renderAddOn: html
  1777. !
  1778. renderTab: aTab on: html
  1779. | li |
  1780. li := html li
  1781. style: 'width: ', self tabWidth asString, 'px';
  1782. class: (aTab isActive ifTrue: [ 'tab active' ] ifFalse: [ 'tab inactive' ]);
  1783. with: [
  1784. html a
  1785. with: [
  1786. ((html tag: 'i') class: 'close')
  1787. onClick: [ self removeTab: aTab ].
  1788. html span
  1789. class: aTab cssClass;
  1790. title: aTab label;
  1791. with: aTab label ];
  1792. at: 'role' put: 'tab'];
  1793. onClick: [ aTab activate ].
  1794. li asDomNode at: 'tab-data' put: aTab
  1795. !
  1796. renderTabsOn: html
  1797. | ul |
  1798. ul := html ul
  1799. class: 'nav navbar-nav nav-tabs';
  1800. at: 'role' put: 'tablist';
  1801. with: [
  1802. self tabs do: [ :each |
  1803. self renderTab: each on: html ] ].
  1804. ul asJQuery sortable: #{
  1805. 'containment' -> 'parent'.
  1806. 'start' -> [ self disableSelection ].
  1807. 'stop' -> [ [ self enableSelection] valueWithTimeout: 300 ].
  1808. 'update' -> [ self updateTabsOrder ]
  1809. }
  1810. !
  1811. show: aTab
  1812. self tabs do: [ :each | each hide ].
  1813. aTab show; focus
  1814. ! !
  1815. !HLTabsWidget methodsFor: 'testing'!
  1816. isSelectionDisabled
  1817. ^ selectionDisabled ifNil: [ false ]
  1818. ! !
  1819. HLTabsWidget class slots: {#current}!
  1820. HLWidget subclass: #HLWelcomeWidget
  1821. slots: {}
  1822. package: 'Helios-Core'!
  1823. !HLWelcomeWidget methodsFor: 'accessing'!
  1824. cssClass
  1825. ^ 'welcome'
  1826. ! !
  1827. !HLWelcomeWidget methodsFor: 'actions'!
  1828. openClassBrowser
  1829. HLBrowser openAsTab
  1830. !
  1831. openHelp
  1832. !
  1833. openTestRunner
  1834. HLSUnit openAsTab
  1835. !
  1836. openWorkspace
  1837. HLWorkspace openAsTab
  1838. ! !
  1839. !HLWelcomeWidget methodsFor: 'rendering'!
  1840. renderButtonsOn: html
  1841. html button
  1842. class: 'button';
  1843. with: 'Class Browser';
  1844. onClick: [ self openClassBrowser ].
  1845. html button
  1846. class: 'button';
  1847. with: 'Workspace';
  1848. onClick: [ self openWorkspace ].
  1849. html button
  1850. class: 'button';
  1851. with: 'Test Runner';
  1852. onClick: [ self openTestRunner ].
  1853. "html button
  1854. class: 'button';
  1855. with: 'Help';
  1856. onClick: [ self openHelp ]"
  1857. !
  1858. renderContentOn: html
  1859. self
  1860. renderHelpOn: html;
  1861. renderButtonsOn: html
  1862. !
  1863. renderHelpOn: html
  1864. html h2 with: 'No tools are open'.
  1865. html ul with: [
  1866. html li with: 'Perform actions with ctrl + space'.
  1867. html li with: 'Open one of the common tools:' ]
  1868. ! !