| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247 |
- Smalltalk current createPackage: 'Helios-Commands-Core'!
- Object subclass: #HLCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLCommand methodsFor: 'accessing'!
- activeBlock
- ^ [ true ]
- !
- documentation
- ^ self class documentation
- !
- key
- ^ self class key
- !
- label
- ^ self class label
- ! !
- !HLCommand methodsFor: 'converting'!
- asActionBinding
- ^ (HLBindingAction on: self key labelled: self label activeBlock: self activeBlock)
- callback: [ self execute ]
- !
- asBinding
- ^ self isBindingGroup
- ifTrue: [ self asGroupBinding ]
- ifFalse: [ self asActionBinding ]
- !
- asGroupBinding
- ^ HLBindingGroup
- on: self key
- labelled: self label
- ! !
- !HLCommand methodsFor: 'executing'!
- execute
- ! !
- !HLCommand methodsFor: 'registration'!
- registerOn: aBinding
- ^ aBinding add: self asBinding
- ! !
- !HLCommand methodsFor: 'testing'!
- isBindingGroup
- ^ (self class methodDictionary includesKey: 'execute') not
- ! !
- !HLCommand class methodsFor: 'accessing'!
- concreteSubclasses
- ^ self subclasses select: [ :each |
- each isConcrete ]
- !
- documentation
- ^ ''
- !
- key
- ^ nil
- !
- label
- ^ ''
- ! !
- !HLCommand class methodsFor: 'converting'!
- asBindingOn: aBinding
- | instance |
-
- instance := self new asBinding.
- aBinding add: instance.
- ^ instance
- ! !
- !HLCommand class methodsFor: 'registration'!
- registerConcreteClassesOn: aBinding
- | newBinding |
-
- self isConcrete
- ifTrue: [ newBinding := self asBindingOn: aBinding ]
- ifFalse: [ newBinding := aBinding ].
-
- self subclasses do: [ :each | each registerConcreteClassesOn: newBinding ]
- !
- registerOn: aBinding
- ^ self new registerOn: aBinding
- ! !
- !HLCommand class methodsFor: 'testing'!
- isConcrete
- ^ self key notNil
- ! !
- HLCommand subclass: #HLCloseTabCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLCloseTabCommand methodsFor: 'executing'!
- execute
- HLManager current removeActiveTab
- ! !
- !HLCloseTabCommand class methodsFor: 'accessing'!
- key
- ^ 87
- !
- label
- ^ 'Close tab'
- ! !
- HLCommand subclass: #HLModelCommand
- instanceVariableNames: 'model'
- package: 'Helios-Commands-Core'!
- !HLModelCommand methodsFor: 'accessing'!
- model
- ^ model
- !
- model: aModel
- model := aModel
- ! !
- !HLModelCommand class methodsFor: 'instance creation'!
- for: aModel
- ^ self new
- ! !
- !HLModelCommand class methodsFor: 'registration'!
- registerConcreteClassesOn: aBinding for: aModel
- self concreteSubclasses do: [ :each | | binding |
- binding := each registerOn: aBinding for: aModel.
- binding isBindingGroup ifTrue: [
- each registerConcreteClassesOn: binding for: aModel ] ]
- !
- registerOn: aBinding for: aModel
- ^ (self for: aModel) registerOn: aBinding
- ! !
- HLCommand subclass: #HLOpenCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLOpenCommand class methodsFor: 'accessing'!
- key
- ^ 79
- !
- label
- ^ 'Open'
- ! !
- HLOpenCommand subclass: #HLOpenBrowserCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLOpenBrowserCommand methodsFor: 'executing'!
- execute
- ^ HLBrowser openAsTab
- ! !
- !HLOpenBrowserCommand class methodsFor: 'accessing'!
- key
- ^ 66
- !
- label
- ^ 'Browser'
- ! !
- HLOpenCommand subclass: #HLOpenTranscriptCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLOpenTranscriptCommand methodsFor: 'executing'!
- execute
- ^ HLTranscript openAsTab
- ! !
- !HLOpenTranscriptCommand class methodsFor: 'accessing'!
- key
- ^ 84
- !
- label
- ^ 'Transcript'
- ! !
- HLOpenCommand subclass: #HLOpenWorkspaceCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLOpenWorkspaceCommand methodsFor: 'executing'!
- execute
- ^ HLCodeWidget openAsTab
- ! !
- !HLOpenWorkspaceCommand class methodsFor: 'accessing'!
- key
- ^ 87
- !
- label
- ^ 'Workspace'
- ! !
- HLCommand subclass: #HLViewCommand
- instanceVariableNames: ''
- package: 'Helios-Commands-Core'!
- !HLViewCommand class methodsFor: 'accessing'!
- label
- ^ 'View'
- ! !
|
