1
0

Helios-Workspace.st 15 KB

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