1
0

Helios-Workspace.st 15 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794
  1. Smalltalk current createPackage: 'Helios-Workspace'!
  2. Object subclass: #HLCodeModel
  3. instanceVariableNames: 'announcer environment receiver'
  4. package: 'Helios-Workspace'!
  5. !HLCodeModel methodsFor: 'accessing'!
  6. announcer
  7. ^ announcer ifNil: [ announcer := Announcer new ]
  8. !
  9. environment
  10. ^ environment ifNil: [ HLManager current environment ]
  11. !
  12. environment: anEnvironment
  13. environment := anEnvironment
  14. !
  15. receiver
  16. ^ receiver ifNil: [ receiver := self defaultReceiver ]
  17. !
  18. receiver: anObject
  19. receiver := anObject
  20. ! !
  21. !HLCodeModel methodsFor: 'actions'!
  22. doIt: aString
  23. ^ self environment eval: aString on: self receiver
  24. !
  25. inspect: anObject
  26. self environment inspect: anObject
  27. ! !
  28. !HLCodeModel methodsFor: 'defaults'!
  29. defaultReceiver
  30. ^ DoIt new
  31. ! !
  32. !HLCodeModel class methodsFor: 'actions'!
  33. on: anEnvironment
  34. ^ self new
  35. environment: anEnvironment;
  36. yourself
  37. ! !
  38. HLWidget subclass: #HLCodeWidget
  39. instanceVariableNames: 'model wrapper code editor state'
  40. package: 'Helios-Workspace'!
  41. !HLCodeWidget methodsFor: 'accessing'!
  42. announcer
  43. ^ self model announcer
  44. !
  45. contents
  46. ^ editor getValue
  47. !
  48. contents: aString
  49. editor setValue: aString.
  50. state ifNotNil: [ self updateState ]
  51. !
  52. currentLine
  53. ^editor getLine: (editor getCursor line)
  54. !
  55. currentLineOrSelection
  56. ^editor somethingSelected
  57. ifFalse: [ self currentLine ]
  58. ifTrue: [ self selection ]
  59. !
  60. editorOptions
  61. ^ #{
  62. 'theme' -> 'amber'.
  63. 'lineNumbers' -> true.
  64. 'enterMode' -> 'flat'.
  65. 'indentWithTabs' -> true.
  66. 'indentUnit' -> 4.
  67. 'matchBrackets' -> true.
  68. 'electricChars' -> false.
  69. 'keyMap' -> 'Amber'.
  70. 'extraKeys' -> #{'Shift-Space' -> 'autocomplete'}
  71. }
  72. !
  73. model
  74. ^ model ifNil: [ model := HLCodeModel new ]
  75. !
  76. model: aModel
  77. model := aModel
  78. !
  79. receiver
  80. ^ self model receiver
  81. !
  82. receiver: anObject
  83. self model receiver: anObject
  84. !
  85. selection
  86. ^editor getSelection
  87. !
  88. selectionEnd
  89. ^code element selectionEnd
  90. !
  91. selectionEnd: anInteger
  92. code element selectionEnd: anInteger
  93. !
  94. selectionStart
  95. ^code element selectionStart
  96. !
  97. selectionStart: anInteger
  98. code element selectionStart: anInteger
  99. ! !
  100. !HLCodeWidget methodsFor: 'actions'!
  101. clear
  102. self contents: ''
  103. !
  104. configureEditor
  105. self editor at: 'amberCodeWidget' put: self.
  106. self editor on: 'change' do: [ self onChange ]
  107. !
  108. doIt
  109. | result |
  110. self model announcer announce: (HLDoItRequested on: model).
  111. result := model doIt: self currentLineOrSelection.
  112. self model announcer announce: (HLDoItExecuted on: model).
  113. ^ result
  114. !
  115. editor
  116. ^ editor
  117. !
  118. focus
  119. editor focus
  120. !
  121. inspectIt
  122. | newInspector |
  123. self model announcer announce: (HLInspectItRequested on: model).
  124. self model inspect: self doIt
  125. !
  126. print: aString
  127. | start stop currentLine |
  128. currentLine := (editor getCursor: false) line.
  129. start := HashedCollection new.
  130. start at: 'line' put: currentLine.
  131. start at: 'ch' put: (editor getCursor: false) ch.
  132. (editor getSelection) ifEmpty: [
  133. "select current line if selection is empty"
  134. start at: 'ch' put: (editor getLine: currentLine) size.
  135. editor setSelection: #{'line' -> currentLine. 'ch' -> 0} end: start.
  136. ].
  137. stop := HashedCollection new.
  138. stop at: 'line' put: currentLine.
  139. stop at: 'ch' put: ((start at: 'ch') + aString size + 2).
  140. editor replaceSelection: (editor getSelection, ' ', aString, ' ').
  141. editor setCursor: (editor getCursor: true).
  142. editor setSelection: stop end: start
  143. !
  144. printIt
  145. | result |
  146. result:= self doIt.
  147. self model announcer announce: (HLPrintItRequested on: model).
  148. self print: result printString.
  149. self focus.
  150. !
  151. saveIt
  152. "I do not do anything"
  153. !
  154. setEditorOn: aTextarea
  155. <self['@editor'] = CodeMirror.fromTextArea(aTextarea, self._editorOptions())>
  156. ! !
  157. !HLCodeWidget methodsFor: 'hints'!
  158. messageHintFor: anEditor token: aToken
  159. ^ ((Smalltalk current at: 'allSelectors') value asSet asArray
  160. select: [ :each | each includesSubString: aToken string ])
  161. reject: [ :each | each = aToken string ]
  162. !
  163. variableHintFor: anEditor token: aToken
  164. | variables classNames pseudoVariables |
  165. variables := ((window jQuery: anEditor display wrapper) find: 'span.cm-variable') get
  166. collect: [ :each | (window jQuery: each) html ].
  167. classNames := Smalltalk current classes collect: [ :each | each name ].
  168. pseudoVariables := Smalltalk current pseudoVariableNames.
  169. ^ ((variables, classNames, pseudoVariables) asSet asArray
  170. select: [ :each | each includesSubString: aToken string ])
  171. reject: [ :each | each = aToken string ]
  172. ! !
  173. !HLCodeWidget methodsFor: 'reactions'!
  174. onChange
  175. self updateState
  176. !
  177. onDoIt
  178. self doIt
  179. !
  180. onInspectIt
  181. self inspectIt
  182. !
  183. onPrintIt
  184. self printIt
  185. !
  186. onSaveIt
  187. "I do not do anything"
  188. ! !
  189. !HLCodeWidget methodsFor: 'rendering'!
  190. renderButtonsOn: html
  191. html button
  192. class: 'button';
  193. with: 'DoIt';
  194. onClick: [ self doIt ].
  195. html button
  196. class: 'button';
  197. with: 'PrintIt';
  198. onClick: [ self printIt ].
  199. html button
  200. class: 'button';
  201. with: 'InspectIt';
  202. onClick: [ self inspectIt ]
  203. !
  204. renderContentOn: html
  205. html div class: 'editor'; with: [
  206. code := html textarea ].
  207. state := html div class: 'state'.
  208. html div
  209. class: 'buttons_bar';
  210. with: [ self renderButtonsOn: html ].
  211. self
  212. setEditorOn: code element;
  213. configureEditor;
  214. updateState
  215. ! !
  216. !HLCodeWidget methodsFor: 'testing'!
  217. canHaveFocus
  218. ^ true
  219. !
  220. hasFocus
  221. ^ code asJQuery is: ':active'
  222. !
  223. hasModification
  224. ^ false
  225. ! !
  226. !HLCodeWidget methodsFor: 'updating'!
  227. updateState
  228. self hasModification
  229. ifTrue: [ state asJQuery addClass: 'modified' ]
  230. ifFalse: [ state asJQuery removeClass: 'modified' ]
  231. ! !
  232. !HLCodeWidget class methodsFor: 'accessing'!
  233. keyMap
  234. ^ HLManager current keyBinder systemIsMac
  235. ifTrue: [ self macKeyMap ]
  236. ifFalse: [ self pcKeyMap ]
  237. !
  238. macKeyMap
  239. ^ #{
  240. 'Alt-Backspace' -> 'delWordBefore'.
  241. 'Alt-Delete' -> 'delWordAfter'.
  242. 'Alt-Left' -> 'goWordBoundaryLeft'.
  243. 'Alt-Right' -> 'goWordBoundaryRight'.
  244. 'Cmd-A' -> 'selectAll'.
  245. 'Cmd-Alt-F' -> 'replace'.
  246. 'Cmd-D' -> 'doIt'.
  247. 'Cmd-Down' -> 'goDocEnd'.
  248. 'Cmd-End' -> 'goDocEnd'.
  249. 'Cmd-F' -> 'find'.
  250. 'Cmd-G' -> 'findNext'.
  251. 'Cmd-I' -> 'inspectIt'.
  252. 'Cmd-Left' -> 'goLineStart'.
  253. 'Cmd-P' -> 'printIt'.
  254. 'Cmd-Right' -> 'goLineEnd'.
  255. 'Cmd-S' -> 'saveIt'.
  256. 'Cmd-Up' -> 'goDocStart'.
  257. 'Cmd-Y' -> 'redo'.
  258. 'Cmd-Z' -> 'undo'.
  259. 'Cmd-[' -> 'indentLess'.
  260. 'Cmd-]' -> 'indentMore'.
  261. 'Ctrl-Alt-Backspace' -> 'delWordAfter'.
  262. 'Shift-Cmd-Alt-F' -> 'replaceAll'.
  263. 'Shift-Cmd-G' -> 'findPrev'.
  264. 'Shift-Cmd-Z' -> 'redo'.
  265. 'fallthrough' -> { 'basic'. 'emacsy' }
  266. }
  267. !
  268. pcKeyMap
  269. ^ #{
  270. 'Alt-Left' -> 'goLineStart'.
  271. 'Alt-Right' -> 'goLineEnd'.
  272. 'Alt-Up' -> 'goDocStart'.
  273. 'Ctrl-A' -> 'selectAll'.
  274. 'Ctrl-Backspace' -> 'delWordBefore'.
  275. 'Ctrl-D' -> 'doIt'.
  276. 'Ctrl-Delete' -> 'delWordAfter'.
  277. 'Ctrl-Down' -> 'goDocEnd'.
  278. 'Ctrl-End' -> 'goDocEnd'.
  279. 'Ctrl-F' -> 'find'.
  280. 'Ctrl-G' -> 'findNext'.
  281. 'Ctrl-I' -> 'inspectIt'.
  282. 'Ctrl-Home' -> 'goDocStart'.
  283. 'Ctrl-Left' -> 'goWordBoundaryLeft'.
  284. 'Ctrl-P' -> 'printIt'.
  285. 'Ctrl-Right' -> 'goWordBoundaryRight'.
  286. 'Ctrl-S' -> 'saveIt'.
  287. 'Ctrl-Y' -> 'redo'.
  288. 'Ctrl-Z' -> 'undo'.
  289. 'Ctrl-[' -> 'indentLess'.
  290. 'Ctrl-]' -> 'indentMore'.
  291. 'Shift-Ctrl-F' -> 'replace'.
  292. 'Shift-Ctrl-G' -> 'findPrev'.
  293. 'Shift-Ctrl-R' -> 'replaceAll'.
  294. 'Shift-Ctrl-Z' -> 'redo'.
  295. 'fallthrough' -> #('basic')
  296. }
  297. ! !
  298. !HLCodeWidget class methodsFor: 'hints'!
  299. hintFor: anEditor options: options
  300. | cursor token completions |
  301. cursor := anEditor getCursor.
  302. token := anEditor getTokenAt: cursor.
  303. token at: 'state' put: ((CodeMirror basicAt: 'innerMode')
  304. value: anEditor getMode value: (token at: 'state')) state.
  305. completions := token type = 'variable'
  306. ifTrue: [ HLCodeWidget variableHintFor: anEditor token: token ]
  307. ifFalse: [ HLCodeWidget messageHintFor: anEditor token: token ].
  308. ^ #{
  309. 'list' -> completions.
  310. 'from' -> ((CodeMirror basicAt: 'Pos') value: cursor line value: token end).
  311. 'to' -> ((CodeMirror basicAt: 'Pos') value: cursor line value: token start)
  312. }
  313. !
  314. messageHintFor: anEditor token: aToken
  315. ^ (anEditor at: 'amberCodeWidget')
  316. messageHintFor: anEditor token: aToken
  317. !
  318. variableHintFor: anEditor token: aToken
  319. ^ (anEditor at: 'amberCodeWidget')
  320. variableHintFor: anEditor token: aToken
  321. ! !
  322. !HLCodeWidget class methodsFor: 'initialization'!
  323. initialize
  324. super initialize.
  325. self
  326. setupCodeMirror;
  327. setupCommands;
  328. setupKeyMaps.
  329. !
  330. setupCodeMirror
  331. <
  332. CodeMirror.keyMap.default.fallthrough = ["basic"];
  333. CodeMirror.commands.autocomplete = function(cm) {
  334. CodeMirror.showHint(cm, self._hintFor_options_);
  335. }
  336. >
  337. !
  338. setupCommands
  339. (CodeMirror basicAt: 'commands')
  340. at: 'doIt' put: [ :cm | cm amberCodeWidget doIt ];
  341. at: 'inspectIt' put: [ :cm | cm amberCodeWidget inspectIt ];
  342. at: 'printIt' put: [ :cm | cm amberCodeWidget printIt ];
  343. at: 'saveIt' put: [ :cm | cm amberCodeWidget saveIt ]
  344. !
  345. setupKeyMaps
  346. <CodeMirror.keyMap['Amber'] = self._keyMap()>
  347. ! !
  348. HLCodeWidget subclass: #HLNavigationCodeWidget
  349. instanceVariableNames: 'methodContents'
  350. package: 'Helios-Workspace'!
  351. !HLNavigationCodeWidget methodsFor: 'accessing'!
  352. configureEditor
  353. super configureEditor.
  354. self contents: self methodContents
  355. !
  356. contents: aString
  357. self methodContents: aString.
  358. super contents: aString
  359. !
  360. methodContents
  361. ^ methodContents ifNil: [ '' ]
  362. !
  363. methodContents: aString
  364. ^ methodContents := aString
  365. !
  366. previous
  367. "for browser lists widget"
  368. !
  369. previous: aWidget
  370. "for browser lists widget"
  371. ! !
  372. !HLNavigationCodeWidget methodsFor: 'testing'!
  373. hasModification
  374. ^ (self methodContents = self contents) not
  375. ! !
  376. !HLNavigationCodeWidget class methodsFor: 'instance creation'!
  377. on: aBrowserModel
  378. ^ self new
  379. browserModel: aBrowserModel;
  380. yourself
  381. ! !
  382. !HLNavigationCodeWidget class methodsFor: 'testing'!
  383. canBeOpenAsTab
  384. ^ false
  385. ! !
  386. HLNavigationCodeWidget subclass: #HLBrowserCodeWidget
  387. instanceVariableNames: 'browserModel'
  388. package: 'Helios-Workspace'!
  389. !HLBrowserCodeWidget methodsFor: 'accessing'!
  390. browserModel
  391. ^ browserModel
  392. !
  393. browserModel: aBrowserModel
  394. browserModel := aBrowserModel.
  395. self
  396. observeSystem;
  397. observeBrowserModel
  398. ! !
  399. !HLBrowserCodeWidget methodsFor: 'actions'!
  400. observeBrowserModel
  401. self browserModel announcer
  402. on: HLSaveSourceCode
  403. send: #onSaveIt
  404. to: self;
  405. on: HLShowInstanceToggled
  406. send: #onShowInstanceToggled
  407. to: self;
  408. on: HLSourceCodeSaved
  409. send: #onSourceCodeSaved
  410. to: self;
  411. on: HLAboutToChange
  412. send: #onBrowserAboutToChange:
  413. to: self;
  414. on: HLParseErrorRaised
  415. send: #onParseError:
  416. to: self;
  417. on: HLCompileErrorRaised
  418. send: #onCompileError:
  419. to: self;
  420. on: HLUnknownVariableErrorRaised
  421. send: #onUnknownVariableError:
  422. to: self;
  423. on: HLInstVarAdded
  424. send: #onInstVarAdded
  425. to: self;
  426. on: HLMethodSelected
  427. send: #onMethodSelected:
  428. to: self;
  429. on: HLClassSelected
  430. send: #onClassSelected:
  431. to: self;
  432. on: HLProtocolSelected
  433. send: #onProtocolSelected:
  434. to: self;
  435. on: HLSourceCodeFocusRequested
  436. send: #onSourceCodeFocusRequested
  437. to: self
  438. !
  439. observeSystem
  440. self browserModel systemAnnouncer
  441. on: MethodModified
  442. send: #onMethodModified:
  443. to: self
  444. !
  445. refresh
  446. self hasModification ifTrue: [ ^ self ].
  447. self hasFocus ifTrue: [ ^ self ].
  448. self contents: self browserModel selectedMethod source
  449. !
  450. renderButtonsOn: html
  451. html button
  452. class: 'button';
  453. with: 'SaveIt';
  454. onClick: [ self saveIt ].
  455. super renderButtonsOn: html
  456. !
  457. saveIt
  458. self browserModel saveSourceCode
  459. !
  460. unregister
  461. super unregsiter.
  462. self browserModel announcer unsubscribe: self.
  463. self browserModel systemAnnouncer unsubscribe: self
  464. ! !
  465. !HLBrowserCodeWidget methodsFor: 'reactions'!
  466. onBrowserAboutToChange: anAnnouncement
  467. | block |
  468. block := anAnnouncement actionBlock.
  469. self hasModification
  470. ifTrue: [
  471. self
  472. confirm: 'Changes have not been saved. Do you want to discard these changes?'
  473. ifTrue: [
  474. "Don't ask twice"
  475. self methodContents: self contents.
  476. block value ].
  477. HLChangeForbidden signal ]
  478. !
  479. onClassSelected: anAnnouncement
  480. | class |
  481. class:= anAnnouncement item.
  482. class ifNil: [ ^ self contents: '' ].
  483. self contents: class definition
  484. !
  485. onCompileError: anAnnouncement
  486. self alert: anAnnouncement error messageText
  487. !
  488. onInstVarAdded
  489. self browserModel save: self contents
  490. !
  491. onMethodModified: anAnnouncement
  492. | method |
  493. method := anAnnouncement method.
  494. self browserModel selectedClass = method methodClass ifFalse: [ ^ self ].
  495. self browserModel selectedMethod ifNil: [ ^ self ].
  496. self browserModel selectedMethod selector = method selector ifFalse: [ ^ self ].
  497. self refresh
  498. !
  499. onMethodSelected: anAnnouncement
  500. | method |
  501. method := anAnnouncement item.
  502. method ifNil: [ ^ self contents: '' ].
  503. self contents: method source
  504. !
  505. onParseError: anAnnouncement
  506. | lineIndex newContents |
  507. lineIndex := 1.
  508. self contents: (String streamContents: [ :stream |
  509. self contents linesDo: [ :each |
  510. lineIndex = anAnnouncement line
  511. ifTrue: [
  512. stream
  513. nextPutAll: (each copyFrom: 1 to: anAnnouncement column);
  514. nextPutAll: '<- ';
  515. nextPutAll: anAnnouncement message;
  516. nextPutAll: ' ';
  517. nextPutAll: (each copyFrom: anAnnouncement column + 1 to: each size) ]
  518. ifFalse: [ stream nextPutAll: each ].
  519. stream nextPutAll: String cr.
  520. lineIndex := lineIndex + 1 ] ])
  521. !
  522. onProtocolSelected: anAnnouncement
  523. self browserModel selectedClass ifNil: [ ^ self contents: '' ].
  524. self contents: self browserModel selectedClass definition
  525. !
  526. onSaveIt
  527. self browserModel save: self contents
  528. !
  529. onShowInstanceToggled
  530. self browserModel selectedClass ifNil: [ ^ self contents: '' ].
  531. self contents: self browserModel selectedClass definition
  532. !
  533. onSourceCodeFocusRequested
  534. self focus
  535. !
  536. onSourceCodeSaved
  537. self methodContents: self contents.
  538. self updateState
  539. !
  540. onUnknownVariableError: anAnnouncement
  541. | error |
  542. error := anAnnouncement error.
  543. self
  544. confirm: (String streamContents: [ :stream |
  545. stream
  546. nextPutAll: error messageText;
  547. nextPutAll: String cr;
  548. nextPutAll: 'Would you like to define an instance variable?' ])
  549. ifTrue: [
  550. self browserModel addInstVarNamed: error variableName ]
  551. ! !
  552. !HLBrowserCodeWidget class methodsFor: 'instance creation'!
  553. on: aBrowserModel
  554. ^ self new
  555. browserModel: aBrowserModel;
  556. yourself
  557. ! !
  558. !HLBrowserCodeWidget class methodsFor: 'testing'!
  559. canBeOpenAsTab
  560. ^ false
  561. ! !
  562. HLWidget subclass: #HLWorkspace
  563. instanceVariableNames: 'codeWidget transcript'
  564. package: 'Helios-Workspace'!
  565. !HLWorkspace methodsFor: 'accessing'!
  566. codeWidget
  567. ^ codeWidget ifNil: [ codeWidget := HLCodeWidget new ]
  568. !
  569. transcript
  570. ^ transcript ifNil: [ transcript := HLTranscript new ]
  571. ! !
  572. !HLWorkspace methodsFor: 'actions'!
  573. focus
  574. ^ self codeWidget focus
  575. !
  576. unregister
  577. super unregister.
  578. self transcript unregister
  579. ! !
  580. !HLWorkspace methodsFor: 'rendering'!
  581. renderContentOn: html
  582. html with: (HLContainer with: (HLHorizontalSplitter
  583. with: self codeWidget
  584. with: [ :canvas | self renderTranscriptOn: canvas ]))
  585. !
  586. renderTranscriptOn: html
  587. html div
  588. class: 'transcript-container';
  589. with: [
  590. html div
  591. class: 'list-label';
  592. with: 'Transcript'.
  593. self transcript renderOn: html ]
  594. ! !
  595. !HLWorkspace methodsFor: 'testing'!
  596. canHaveFocus
  597. ^ true
  598. ! !
  599. !HLWorkspace class methodsFor: 'accessing'!
  600. tabClass
  601. ^ 'workspace'
  602. !
  603. tabLabel
  604. ^ 'Workspace'
  605. !
  606. tabPriority
  607. ^ 10
  608. ! !
  609. !HLWorkspace class methodsFor: 'testing'!
  610. canBeOpenAsTab
  611. ^ true
  612. ! !