Helios-Commands-Core.st 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289
  1. Smalltalk current createPackage: 'Helios-Commands-Core'!
  2. Object subclass: #HLCommand
  3. instanceVariableNames: 'input'
  4. package: 'Helios-Commands-Core'!
  5. !HLCommand methodsFor: 'accessing'!
  6. documentation
  7. ^ self class documentation
  8. !
  9. input
  10. ^ input
  11. !
  12. input: aString
  13. ^ input := aString
  14. !
  15. inputCompletion
  16. ^ #()
  17. !
  18. inputLabel
  19. ^ self label
  20. !
  21. key
  22. ^ self class key
  23. !
  24. label
  25. ^ self class label
  26. !
  27. menuLabel
  28. ^ self class menuLabel
  29. ! !
  30. !HLCommand methodsFor: 'converting'!
  31. asActionBinding
  32. ^ (HLBindingAction on: self key labelled: self label)
  33. command: self;
  34. yourself
  35. !
  36. asBinding
  37. ^ self isBindingGroup
  38. ifTrue: [ self asGroupBinding ]
  39. ifFalse: [ self asActionBinding ]
  40. !
  41. asGroupBinding
  42. ^ HLBindingGroup
  43. on: self key
  44. labelled: self label
  45. ! !
  46. !HLCommand methodsFor: 'error handling'!
  47. commandError: aString
  48. self error: aString
  49. ! !
  50. !HLCommand methodsFor: 'executing'!
  51. execute
  52. ! !
  53. !HLCommand methodsFor: 'registration'!
  54. registerOn: aBinding
  55. ^ aBinding add: self asBinding
  56. ! !
  57. !HLCommand methodsFor: 'testing'!
  58. isActive
  59. ^ true
  60. !
  61. isBindingGroup
  62. ^ (self class methodDictionary includesKey: 'execute') not
  63. !
  64. isInputRequired
  65. ^ false
  66. ! !
  67. !HLCommand class methodsFor: 'accessing'!
  68. documentation
  69. ^ ''
  70. !
  71. key
  72. ^ nil
  73. !
  74. label
  75. ^ ''
  76. !
  77. menuLabel
  78. ^ self label
  79. !
  80. registerConcreteClassesOn: aBinding
  81. | newBinding |
  82. self isConcrete
  83. ifTrue: [ newBinding := self registerOn: aBinding ]
  84. ifFalse: [ newBinding := aBinding ].
  85. self subclasses do: [ :each | each registerConcreteClassesOn: newBinding ]
  86. ! !
  87. !HLCommand class methodsFor: 'registration'!
  88. concreteClasses
  89. | classes |
  90. classes := OrderedCollection new.
  91. self isConcrete
  92. ifTrue: [ classes add: self ].
  93. self subclasses do: [ :each |
  94. classes addAll: each concreteClasses ].
  95. ^ classes
  96. !
  97. registerOn: aBinding
  98. ^ self new registerOn: aBinding
  99. ! !
  100. !HLCommand class methodsFor: 'testing'!
  101. isConcrete
  102. ^ self key notNil
  103. !
  104. isValidFor: aModel
  105. ^ false
  106. ! !
  107. HLCommand subclass: #HLCloseTabCommand
  108. instanceVariableNames: ''
  109. package: 'Helios-Commands-Core'!
  110. !HLCloseTabCommand methodsFor: 'executing'!
  111. execute
  112. HLManager current removeActiveTab
  113. ! !
  114. !HLCloseTabCommand class methodsFor: 'accessing'!
  115. key
  116. ^ 87
  117. !
  118. label
  119. ^ 'Close tab'
  120. ! !
  121. HLCommand subclass: #HLModelCommand
  122. instanceVariableNames: 'model'
  123. package: 'Helios-Commands-Core'!
  124. !HLModelCommand methodsFor: 'accessing'!
  125. model
  126. ^ model
  127. !
  128. model: aModel
  129. model := aModel
  130. ! !
  131. !HLModelCommand class methodsFor: 'instance creation'!
  132. for: aModel
  133. ^ self new
  134. ! !
  135. !HLModelCommand class methodsFor: 'registration'!
  136. registerConcreteClassesOn: aBinding for: aModel
  137. | newBinding |
  138. self isConcrete
  139. ifTrue: [ newBinding := self registerOn: aBinding for: aModel ]
  140. ifFalse: [ newBinding := aBinding ].
  141. self subclasses do: [ :each |
  142. each registerConcreteClassesOn: newBinding for: aModel ]
  143. !
  144. registerOn: aBinding for: aModel
  145. ^ (self for: aModel) registerOn: aBinding
  146. ! !
  147. HLCommand subclass: #HLOpenCommand
  148. instanceVariableNames: ''
  149. package: 'Helios-Commands-Core'!
  150. !HLOpenCommand class methodsFor: 'accessing'!
  151. key
  152. ^ 79
  153. !
  154. label
  155. ^ 'Open'
  156. ! !
  157. HLOpenCommand subclass: #HLOpenBrowserCommand
  158. instanceVariableNames: ''
  159. package: 'Helios-Commands-Core'!
  160. !HLOpenBrowserCommand methodsFor: 'executing'!
  161. execute
  162. ^ HLBrowser openAsTab
  163. ! !
  164. !HLOpenBrowserCommand class methodsFor: 'accessing'!
  165. key
  166. ^ 66
  167. !
  168. label
  169. ^ 'Browser'
  170. ! !
  171. HLOpenCommand subclass: #HLOpenTranscriptCommand
  172. instanceVariableNames: ''
  173. package: 'Helios-Commands-Core'!
  174. !HLOpenTranscriptCommand methodsFor: 'executing'!
  175. execute
  176. ^ HLTranscript openAsTab
  177. ! !
  178. !HLOpenTranscriptCommand class methodsFor: 'accessing'!
  179. key
  180. ^ 84
  181. !
  182. label
  183. ^ 'Transcript'
  184. ! !
  185. HLOpenCommand subclass: #HLOpenWorkspaceCommand
  186. instanceVariableNames: ''
  187. package: 'Helios-Commands-Core'!
  188. !HLOpenWorkspaceCommand methodsFor: 'executing'!
  189. execute
  190. ^ HLCodeWidget openAsTab
  191. ! !
  192. !HLOpenWorkspaceCommand class methodsFor: 'accessing'!
  193. key
  194. ^ 87
  195. !
  196. label
  197. ^ 'Workspace'
  198. ! !
  199. HLCommand subclass: #HLViewCommand
  200. instanceVariableNames: ''
  201. package: 'Helios-Commands-Core'!
  202. !HLViewCommand class methodsFor: 'accessing'!
  203. label
  204. ^ 'View'
  205. ! !