Helios-Commands-Core.st 4.0 KB

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