| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345 |
- Smalltalk createPackage: 'Helios-Commands-Core'!
- Object subclass: #HLCommand
- slots: {#input}
- package: 'Helios-Commands-Core'!
- !HLCommand methodsFor: 'accessing'!
- documentation
- ^ self class documentation
- !
- input
- ^ input
- !
- input: aString
- ^ input := aString
- !
- inputCompletion
- ^ #()
- !
- inputLabel
- ^ self label
- !
- key
- ^ self class key
- !
- keyCode
- ^ self key asUppercase charCodeAt: 1
- !
- label
- ^ self class label
- !
- menuLabel
- ^ self class menuLabel
- ! !
- !HLCommand methodsFor: 'converting'!
- asActionBinding
- ^ (HLBindingAction on: self keyCode labelled: self label)
- command: self;
- yourself
- !
- asBinding
- ^ self isBindingGroup
- ifTrue: [ self asGroupBinding ]
- ifFalse: [ self asActionBinding ]
- !
- asGroupBinding
- ^ HLBindingGroup
- on: self keyCode
- labelled: self label
- ! !
- !HLCommand methodsFor: 'defaults'!
- defaultInput
- ^ ''
- ! !
- !HLCommand methodsFor: 'error handling'!
- commandError: aString
- self error: aString
- ! !
- !HLCommand methodsFor: 'executing'!
- execute
- ! !
- !HLCommand methodsFor: 'registration'!
- registerOn: aBinding
- ^ aBinding add: self asBinding
- ! !
- !HLCommand methodsFor: 'testing'!
- isAction
- ^ self isBindingGroup not
- !
- isActive
- ^ true
- !
- isBindingGroup
- ^ (self class methodDictionary includesKey: 'execute') not
- !
- isInputRequired
- ^ false
- ! !
- !HLCommand class methodsFor: 'accessing'!
- documentation
- ^ ''
- !
- key
- "Answer a single character string or nil if no key"
-
- ^ nil
- !
- label
- ^ ''
- !
- menuLabel
- ^ self label
- !
- registerConcreteClassesOn: aBinding
- | newBinding |
-
- self isConcrete
- ifTrue: [ newBinding := self registerOn: aBinding ]
- ifFalse: [ newBinding := aBinding ].
-
- self subclasses do: [ :each | each registerConcreteClassesOn: newBinding ]
- ! !
- !HLCommand class methodsFor: 'registration'!
- concreteClasses
- | classes |
-
- classes := OrderedCollection new.
-
- self isConcrete
- ifTrue: [ classes add: self ].
-
- self subclasses do: [ :each |
- classes addAll: each concreteClasses ].
-
- ^ classes
- !
- registerOn: aBinding
- ^ self new registerOn: aBinding
- ! !
- !HLCommand class methodsFor: 'testing'!
- isConcrete
- ^ self key notNil
- !
- isValidFor: aModel
- ^ true
- ! !
- HLCommand subclass: #HLCloseTabCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLCloseTabCommand methodsFor: 'executing'!
- execute
- HLManager current removeActiveTab
- ! !
- !HLCloseTabCommand class methodsFor: 'accessing'!
- key
- ^ 'w'
- !
- label
- ^ 'Close tab'
- ! !
- HLCommand subclass: #HLModelCommand
- slots: {#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
- | newBinding |
-
- (self isConcrete and: [ self isValidFor: aModel ])
- ifTrue: [ newBinding := self registerOn: aBinding for: aModel ]
- ifFalse: [ newBinding := aBinding ].
-
- self subclasses do: [ :each |
- each registerConcreteClassesOn: newBinding for: aModel ]
- !
- registerOn: aBinding for: aModel
- ^ (self for: aModel) registerOn: aBinding
- ! !
- HLCommand subclass: #HLOpenCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLOpenCommand class methodsFor: 'accessing'!
- key
- ^ 'o'
- !
- label
- ^ 'Open'
- ! !
- HLOpenCommand subclass: #HLOpenBrowserCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLOpenBrowserCommand methodsFor: 'executing'!
- execute
- ^ HLBrowser openAsTab
- ! !
- !HLOpenBrowserCommand class methodsFor: 'accessing'!
- key
- ^ 'b'
- !
- label
- ^ 'Browser'
- ! !
- HLOpenCommand subclass: #HLOpenSUnitCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLOpenSUnitCommand methodsFor: 'executing'!
- execute
- ^ HLSUnit openAsTab
- ! !
- !HLOpenSUnitCommand class methodsFor: 'accessing'!
- key
- ^ 's'
- !
- label
- ^ 'SUnit'
- ! !
- HLOpenCommand subclass: #HLOpenWorkspaceCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLOpenWorkspaceCommand methodsFor: 'executing'!
- execute
- ^ HLWorkspace openAsTab
- ! !
- !HLOpenWorkspaceCommand class methodsFor: 'accessing'!
- key
- ^ 'w'
- !
- label
- ^ 'Workspace'
- ! !
- HLCommand subclass: #HLSwitchTabCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLSwitchTabCommand methodsFor: 'accessing'!
- selectedTab
- ^ HLManager current activeTab
- !
- tabs
- ^ HLManager current tabs
- ! !
- !HLSwitchTabCommand methodsFor: 'executing'!
- execute
- | activeTab |
-
- activeTab := self selectedTab.
-
- ^ HLTabSelectionWidget new
- tabs: self tabs;
- selectedTab: self selectedTab;
- selectCallback: [ :tab | tab activate ];
- confirmCallback: [ :tab | tab focus ];
- cancelCallback: [ activeTab activate ];
- show
- ! !
- !HLSwitchTabCommand class methodsFor: 'accessing'!
- key
- ^ 's'
- !
- label
- ^ 'Switch tab'
- ! !
- HLCommand subclass: #HLViewCommand
- slots: {}
- package: 'Helios-Commands-Core'!
- !HLViewCommand class methodsFor: 'accessing'!
- label
- ^ 'View'
- ! !
|
