2
0

Helios-Workspace.st 14 KB

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