2
0

Helios-Workspace.st 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735
  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. send: #onSaveIt
  382. to: self;
  383. on: HLShowInstanceToggled
  384. send: #onShowInstanceToggled
  385. to: self;
  386. on: HLSourceCodeSaved
  387. send: #onSourceCodeSaved
  388. to: self;
  389. on: HLAboutToChange
  390. send: #onBrowserAboutToChange:
  391. to: self;
  392. on: HLParseErrorRaised
  393. send: #onParseError:
  394. to: self;
  395. on: HLCompileErrorRaised
  396. send: #onCompileError:
  397. to: self;
  398. on: HLUnknownVariableErrorRaised
  399. send: #onUnknownVariableError:
  400. to: self;
  401. on: HLInstVarAdded
  402. send: #onInstVarAdded
  403. to: self;
  404. on: HLMethodSelected
  405. send: #onMethodSelected:
  406. to: self;
  407. on: HLClassSelected
  408. send: #onClassSelected:
  409. to: self;
  410. on: HLProtocolSelected
  411. send: #onProtocolSelected:
  412. to: self;
  413. on: HLSourceCodeFocusRequested
  414. send: #onSourceCodeFocusRequested
  415. to: self
  416. !
  417. observeSystem
  418. self browserModel systemAnnouncer
  419. on: MethodModified
  420. send: #onMethodModified:
  421. to: self
  422. !
  423. refresh
  424. self hasModification ifTrue: [ ^ self ].
  425. self hasFocus ifTrue: [ ^ self ].
  426. self contents: self browserModel selectedMethod source
  427. !
  428. saveIt
  429. self browserModel saveSourceCode
  430. !
  431. unregister
  432. super unregsiter.
  433. self browserModel announcer unsubscribe: self.
  434. self browserModel systemAnnouncer unsubscribe: self
  435. ! !
  436. !HLBrowserCodeWidget methodsFor: 'reactions'!
  437. onBrowserAboutToChange: anAnnouncement
  438. | block |
  439. block := anAnnouncement actionBlock.
  440. self hasModification
  441. ifTrue: [
  442. self
  443. confirm: 'Do you want to cancel changes?'
  444. ifTrue: [
  445. "Don't ask twice"
  446. self methodContents: self contents.
  447. block value ].
  448. HLChangeForbidden signal ]
  449. !
  450. onClassSelected: anAnnouncement
  451. | class |
  452. class:= anAnnouncement item.
  453. class ifNil: [ ^ self contents: '' ].
  454. self contents: class definition
  455. !
  456. onCompileError: anAnnouncement
  457. self alert: anAnnouncement error messageText
  458. !
  459. onInstVarAdded
  460. self browserModel save: self contents
  461. !
  462. onMethodModified: anAnnouncement
  463. | method |
  464. method := anAnnouncement method.
  465. self browserModel selectedClass = method methodClass ifFalse: [ ^ self ].
  466. self browserModel selectedMethod ifNil: [ ^ self ].
  467. self browserModel selectedMethod selector = method selector ifFalse: [ ^ self ].
  468. self refresh
  469. !
  470. onMethodSelected: anAnnouncement
  471. | method |
  472. method := anAnnouncement item.
  473. method ifNil: [ ^ self contents: '' ].
  474. self contents: method source
  475. !
  476. onParseError: anAnnouncement
  477. | lineIndex newContents |
  478. lineIndex := 1.
  479. self contents: (String streamContents: [ :stream |
  480. self contents linesDo: [ :each |
  481. lineIndex = anAnnouncement line
  482. ifTrue: [
  483. stream
  484. nextPutAll: (each copyFrom: 1 to: anAnnouncement column);
  485. nextPutAll: '<- ';
  486. nextPutAll: anAnnouncement message;
  487. nextPutAll: ' ';
  488. nextPutAll: (each copyFrom: anAnnouncement column + 1 to: each size) ]
  489. ifFalse: [ stream nextPutAll: each ].
  490. stream nextPutAll: String cr.
  491. lineIndex := lineIndex + 1 ] ])
  492. !
  493. onProtocolSelected: anAnnouncement
  494. self browserModel selectedClass ifNil: [ ^ self contents: '' ].
  495. self contents: self browserModel selectedClass definition
  496. !
  497. onSaveIt
  498. self browserModel save: self contents
  499. !
  500. onShowInstanceToggled
  501. self browserModel selectedClass ifNil: [ ^ self contents: '' ].
  502. self contents: self browserModel selectedClass definition
  503. !
  504. onSourceCodeFocusRequested
  505. self focus
  506. !
  507. onSourceCodeSaved
  508. self methodContents: self contents.
  509. self updateState
  510. !
  511. onUnknownVariableError: anAnnouncement
  512. | error |
  513. error := anAnnouncement error.
  514. self
  515. confirm: (String streamContents: [ :stream |
  516. stream
  517. nextPutAll: error messageText;
  518. nextPutAll: String cr;
  519. nextPutAll: 'Would you like to define an instance variable?' ])
  520. ifTrue: [
  521. self browserModel addInstVarNamed: error variableName ]
  522. ! !
  523. !HLBrowserCodeWidget class methodsFor: 'instance creation'!
  524. on: aBrowserModel
  525. ^ self new
  526. browserModel: aBrowserModel;
  527. yourself
  528. ! !
  529. !HLBrowserCodeWidget class methodsFor: 'testing'!
  530. canBeOpenAsTab
  531. ^ false
  532. ! !
  533. HLWidget subclass: #HLWorkspace
  534. instanceVariableNames: 'codeWidget'
  535. package: 'Helios-Workspace'!
  536. !HLWorkspace methodsFor: 'accessing'!
  537. codeWidget
  538. ^ codeWidget ifNil: [ codeWidget := HLCodeWidget new ]
  539. ! !
  540. !HLWorkspace methodsFor: 'actions'!
  541. focus
  542. ^ self codeWidget focus
  543. ! !
  544. !HLWorkspace methodsFor: 'rendering'!
  545. renderContentOn: html
  546. html with: (HLContainer with: self codeWidget)
  547. ! !
  548. !HLWorkspace methodsFor: 'testing'!
  549. canHaveFocus
  550. ^ true
  551. ! !
  552. !HLWorkspace class methodsFor: 'accessing'!
  553. tabLabel
  554. ^ 'Workspace'
  555. !
  556. tabPriority
  557. ^ 10
  558. ! !
  559. !HLWorkspace class methodsFor: 'testing'!
  560. canBeOpenAsTab
  561. ^ true
  562. ! !