Squeak 4.6: Services-Base-mt.55.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

Squeak 4.6: Services-Base-mt.55.mcz

commits-2
Chris Muller uploaded a new version of Services-Base to project Squeak 4.6:
http://source.squeak.org/squeak46/Services-Base-mt.55.mcz

==================== Summary ====================

Name: Services-Base-mt.55
Author: mt
Time: 12 April 2015, 9:07:10.492 pm
UUID: 3b374e3f-27ec-ff4f-9af9-89da39d9d38b
Ancestors: Services-Base-topa.54

MVC compatibility.

==================== Snapshot ====================

SystemOrganization addCategory: #'Services-Base'!
SystemOrganization addCategory: #'Services-Base-Providers'!
SystemOrganization addCategory: #'Services-Base-Requestors'!
SystemOrganization addCategory: #'Services-Base-GUI'!

Preferences subclass: #ServicePreferences
        instanceVariableNames: ''
        classVariableNames: 'ServiceDictionaryOfPreferences'
        poolDictionaries: ''
        category: 'Services-Base-GUI'!

!ServicePreferences commentStamp: 'rr 7/10/2006 15:36' prior: 0!
I store the preferences related to the servicse framework. The preferences are editable via the Services Browser, based on Hernan Tylim's Preference Browser.

The main preference categories for services are:

-- keyboard shortcuts -- : several text preferences, one per keyboard shortcuts. To edit them,  enter a service identifier (equal to the method name under which it is defined in its ServiceProvider), and accept with alt-s or enter

-- menu contents -- : All the service categories in the image have a text preference under here. To edit it, enter the services identifiers you wish to put in this category, separating them with a single space character. The order is important: it defines the order of the items in menus.

-- settings -- : general boolean preferences.

Then there is a preference category for each provider in the image. Under each, you will find:
A boolean preference for each service in the image. If it is false, the service will not appear in menus.
The text preference for each service category defined by the service provider. This is the same as the one appearing in the menu contents preference category.!

----- Method: ServicePreferences class>>compileAccessMethodForPreference: (in category 'accessing') -----
compileAccessMethodForPreference: aPreference
        "do nothing"!

----- Method: ServicePreferences class>>dictionaryOfPreferences (in category 'accessing') -----
dictionaryOfPreferences
        ServiceDictionaryOfPreferences
                ifNil: [ServiceDictionaryOfPreferences := IdentityDictionary new].
        ^ ServiceDictionaryOfPreferences !

----- Method: ServicePreferences class>>dictionaryOfPreferences: (in category 'accessing') -----
dictionaryOfPreferences: aDictionary
        ServiceDictionaryOfPreferences := aDictionary!

----- Method: ServicePreferences class>>replayPreferences: (in category 'replaying') -----
replayPreferences: preferences
        | s |
        s := SortedCollection new
                                sortBlock: [:a :b | a last < b last].
        s addAll: preferences;
                 reSort.
        s
                do: [:e | | v |
                        v := self valueOfPreference: e first ifAbsent: ''.
                        self setPreference: e first toValue: (v
                                        ifEmpty: ['']
                                        ifNotEmpty: [v , ' '])
                                        , e second]!

----- Method: ServicePreferences class>>wipe (in category 'accessing') -----
wipe
        self dictionaryOfPreferences: nil!

----- Method: PasteUpMorph>>openWorldMenu (in category '*services-base') -----
openWorldMenu
        | menu |
        menu := (TheWorldMenu new adaptToWorld: self) buildWorldMenu.
        menu addTitle: Preferences desktopMenuTitle translated.
        menu openInHand!

----- Method: PasteUpMorph>>requestor (in category '*services-base') -----
requestor
        "returns the focused window's requestor"
        ^ Requestor default!

----- Method: PasteUpMorph>>topRequestor (in category '*services-base') -----
topRequestor
        "returns the focused window's requestor"
        ^ SystemWindow topWindow requestor!

----- Method: PasteUpMorph>>worldMenu (in category '*services-base') -----
worldMenu
        ^ TheWorldMenu new adaptToWorld: self!

----- Method: Model>>requestor (in category '*services-base') -----
requestor
        ^ Requestor default!

----- Method: StringHolder>>codePaneMenuServices: (in category '*services-base') -----
codePaneMenuServices: aMenu
        <codePaneMenu>
        <menuPriority: 150>
        ServiceGui browser: self codePaneMenu: aMenu.
        ^ Preferences useOnlyServicesInMenu ifTrue: [nil] ifFalse: [aMenu]!

----- Method: StringHolder>>requestor (in category '*services-base') -----
requestor
        ^ (TextRequestor new) model: self; yourself!

----- Method: StringHolder>>selectedInterval (in category '*services-base') -----
selectedInterval
        ^self codeTextMorph selectionInterval!

----- Method: Collection>>chooseOne: (in category '*services-base') -----
chooseOne: caption
        "pops up a menu asking for one of the elements in the collection.
        If none is chosen, raises a ServiceCancelled notification"

        | m |
        m := MenuMorph entitled: caption.
        self do:
                        [:ea |
                        m
                                add: ea
                                target: [:n | ^ n]
                                selector: #value:
                                argument: ea].
        m invokeModal.
        ServiceCancelled signal!

----- Method: PreferenceBrowserMorph class>>updateBrowsers (in category '*services-base') -----
updateBrowsers

        (self allInstances select: [:e | e visible])
                do: [:each |
                        (each  findDeepSubmorphThat:[:m | m  isKindOf:PluggableListMorph]
                                ifAbsent:[^ self]) verifyContents].!

PreferenceBrowserMorph subclass: #ServiceBrowserMorph
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-GUI'!

!ServiceBrowserMorph commentStamp: 'rr 7/10/2006 15:28' prior: 0!
I subclass the PreferenceBrowserMorph to adapt the interface to services. So far the changes are minimal.!

----- Method: ServiceBrowserMorph>>newButtonRow (in category 'as yet unclassified') -----
newButtonRow
        ^BorderedMorph new
                color: Color transparent;
                cellInset: 2;
                layoutInset: 2;
                layoutPolicy: TableLayout new;
                listDirection: #leftToRight;
                listCentering: #topLeft;
                cellPositioning: #topLeft;
                on: #mouseEnter send: #paneTransition: to: self;
                on: #mouseLeave send: #paneTransition: to: self;
                "addMorphBack: self defaultButton;
                addMorphBack: self newSeparator;
                addMorphBack: self saveButton;
                addMorphBack: self loadButton;
                addMorphBack: self newSeparator;
                addMorphBack: self saveToDiskButton;
                addMorphBack: self loadFromDiskButton;
                addMorphBack: self newSeparator;
                addMorphBack: self newTransparentFiller;
                addMorphBack: self helpButton;"
                yourself.!

----- Method: SystemWindow class>>topWindow (in category '*services-base') -----
topWindow
        ^ TopWindow!

----- Method: SystemWindow>>requestor (in category '*services-base') -----
requestor
        ^[model requestor]
                on: Error
                do: [Transcript show: 'no requestor for : ', model class name. Requestor default] !

----- Method: SystemWindow>>topWindow (in category '*services-base') -----
topWindow
        ^ TopWindow!

----- Method: BlockContext>>valueWithRequestor: (in category '*services-base') -----
valueWithRequestor: aRequestor
        "To do later: make the fillInTheBlank display more informative captions.
        Include the description of the service, and maybe record steps"

        ^ self numArgs isZero
                ifTrue: [self value]
                ifFalse: [self value: aRequestor]!

----- Method: Association>>serviceUpdate (in category '*services-base-preferences') -----
serviceUpdate
        self key service perform: self value!

----- Method: PreferenceBrowser class>>openForServices (in category '*services-base') -----
openForServices
        "PreferenceBrowser openForServices"
        | browser |
        browser := self new.
        browser initializeForServices.
        (ServiceBrowserMorph withModel: browser)
                openInWorld.
        ^browser. !

----- Method: PreferenceBrowser>>initializeForServices (in category '*services-base') -----
initializeForServices
        preferences := ServicePreferences.
        title := 'Services Browser'!

----- Method: MessageSet>>browseReference: (in category '*services-base') -----
browseReference: ref
        self okToChange ifTrue: [
        self initializeMessageList: (OrderedCollection with: ref).
        self changed: #messageList.
        self messageListIndex: 1.
        ] !

----- Method: MessageSet>>selectReference: (in category '*services-base') -----
selectReference: ref
        self okToChange ifTrue: [self messageListIndex: (self messageList indexOf: ref)]!

----- Method: String>>service (in category '*services-base') -----
service
        ^ self serviceOrNil ifNil: [ServiceCategory new id: self asSymbol]!

----- Method: String>>serviceOrNil (in category '*services-base') -----
serviceOrNil
        ^ ServiceRegistry current serviceWithId: self asSymbol!

Object subclass: #BasicRequestor
        instanceVariableNames: 'caption answer'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base'!

!BasicRequestor commentStamp: 'rr 7/10/2006 14:44' prior: 0!
This class is the root of the Requestor hierarchy.

Requestors are interfaces between services and the system. ServiceActions are given an instance
of a Requestor, and they ask it for the data they need. The requestor is determined by the model of the application. A class used as a model can implement the #requestor message to return the most suited requestor. A requestor knows how to query its model and the user if needed.

Requestor are defined in hierarchies so that the protocol they rely on (methods starting with 'get') can be easily reused.!

----- Method: BasicRequestor>>caption: (in category 'generic requests') -----
caption: aString
        caption := aString!

----- Method: BasicRequestor>>get: (in category 'executing') -----
get: aString
        self caption: aString.
        ^ self getSymbol!

----- Method: BasicRequestor>>getString (in category 'generic requests') -----
getString
        | result |
        result := UIManager default  request:caption  initialAnswer:answer contents.
        self newCaption.
        result isEmpty  |result isNil  ifTrue:[ServiceCancelled signal].
        ^ result!

----- Method: BasicRequestor>>getStringCollection (in category 'generic requests') -----
getStringCollection
        caption := caption, Character cr asString, 'Separate items with space'.
        ^ (self getString findTokens: ' ') collect: [:each | each copyWithoutAll: ' ' ]!

----- Method: BasicRequestor>>getSymbol (in category 'generic requests') -----
getSymbol
        ^ self getString asSymbol!

----- Method: BasicRequestor>>getSymbolCollection (in category 'generic requests') -----
getSymbolCollection
        ^[self getStringCollection collect: [:each | each asSymbol]]
                on: ServiceCancelled
                do: [#()]!

----- Method: BasicRequestor>>initialize (in category 'initialize-release') -----
initialize
        self newCaption!

----- Method: BasicRequestor>>newCaption (in category 'generic requests') -----
newCaption
        caption := 'Enter text'.
        answer := String new writeStream.!

BasicRequestor subclass: #Requestor
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-Requestors'!

!Requestor commentStamp: 'rr 7/10/2006 15:19' prior: 0!
I am an implementation of BasicRequestor with some requests already implemented.!

----- Method: Requestor class>>default (in category 'as yet unclassified') -----
default
        "returns a default requestor"
        ^ self new!

----- Method: Requestor>>getClass (in category 'requests') -----
getClass
        ^Smalltalk at: self getSymbol!

----- Method: Requestor>>getClassCollection (in category 'requests') -----
getClassCollection
        ^ self getSymbolCollection collect: [:className | Smalltalk at: className]!

----- Method: Requestor>>getMethodBody (in category 'requests') -----
getMethodBody
        | m |
        m := FillInTheBlankMorph new.
        m setQuery: 'Please enter the full body of the method you want to define'
                initialAnswer:  self class sourceCodeTemplate
                answerExtent: 500@250
                acceptOnCR: false.
        World addMorph: m centeredNear: World activeHand position.
        ^ m getUserResponse.!

----- Method: Requestor>>getSelection (in category 'requests') -----
getSelection
        "Sorry to feedle with fillInTheBlankMorph innards, but I had to"
        | text m |
        text := (MethodReference class: self getClass selector: self getSelector) sourceCode.
        m := FillInTheBlankMorph new.
        m setQuery: 'Highlight a part of the source code, and accept' initialAnswer: text
                answerExtent: 500@250
                acceptOnCR: true.
        World addMorph: m centeredNear: World activeHand position.
        m getUserResponse.
        ^ m selection!

----- Method: Requestor>>getSelector (in category 'services requests') -----
getSelector
        ^ self caption: 'enter selector'; getSymbol!

Requestor subclass: #TextRequestor
        instanceVariableNames: 'model'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-Requestors'!

!TextRequestor commentStamp: 'rr 7/10/2006 15:20' prior: 0!
A requestor for text areas, able for example to fetch the current selected text.!

TextRequestor subclass: #BrowserRequestor
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-Requestors'!

!BrowserRequestor commentStamp: 'rr 7/10/2006 15:24' prior: 0!
I am a requestor specialized to fetch information in a Browser.
I can ask a browser its selected class and selected method for example.
If the RB is installed too, I can also fetch ast nodes in the browser's selected
method.

I am the default requestor for CodeHolder and it's subclasses.

To be integrated with services, alternative browsers, such as the OmniBrowser and Whisker should define a specialized requestor subclassing this one. A few core messages would need to be redefined, such as getClass, getMessage ... to be adapted to the browser's data structures.
Only a few of them have to be overridden, the majority of the requests rely on a few base ones.!

----- Method: BrowserRequestor>>browser: (in category 'initialize-release') -----
browser: b
        self model: b!

----- Method: BrowserRequestor>>getBrowser (in category 'requests') -----
getBrowser
        ^ self getModel!

----- Method: BrowserRequestor>>getClass (in category 'requests') -----
getClass
        ^ self getBrowser selectedClassOrMetaClass!

----- Method: BrowserRequestor>>getInitializingExpressionForTheNewParameter (in category 'requests') -----
getInitializingExpressionForTheNewParameter
        ^ UIManager default request: 'enter default parameter code'
                                 initialAnswer: '42'!

----- Method: BrowserRequestor>>getNewSelectorName (in category 'requests') -----
getNewSelectorName
        ^ UIManager default  request: 'enter the new selector name'
                                        initialAnswer: self getSelector!

----- Method: BrowserRequestor>>getNewVariableName (in category 'requests') -----
getNewVariableName
        ^ UIManager default request: 'Enter the new variable name' translated initialAnswer: 'foo'!

----- Method: BrowserRequestor>>getPackage (in category 'requests') -----
getPackage
        self getSelector ifNil: [
                        ^ PackageInfo named:(
                                        self getClass ifNil: [self getSystemCategory]
                                                                        ifNotNil: [:c | c category copyUpTo:  $-])].
        ^ PackageOrganizer default
                        packageOfMethod:
                                        (MethodReference class: self getClass
                                                                                selector: self getSelector)
                        ifNone: [PackageInfo named: (self getClass category copyUpTo:  $-)] !

----- Method: BrowserRequestor>>getPackageForCategory (in category 'requests') -----
getPackageForCategory
        "answers a packageinfo for the current class category"
        ^ PackageInfo named: self getClass category!

----- Method: BrowserRequestor>>getPackageForCategoryName (in category 'requests') -----
getPackageForCategoryName
        "answers a packageinfo for the current class category"
        ^  self getPackageForCategory packageName!

----- Method: BrowserRequestor>>getPackageName (in category 'requests') -----
getPackageName
        ^ self getPackage packageName!

----- Method: BrowserRequestor>>getPackageProvider (in category 'requests') -----
getPackageProvider
        | provs classes |
        provs := ServiceProvider registeredProviders.
        classes := self getPackage classes.
        ^ classes detect: [:e | provs includes: e] ifNone: [ServiceProvider newProviderFor: self getPackageName]!

----- Method: BrowserRequestor>>getSelection (in category 'requests') -----
getSelection
        self getBrowser selectedInterval ifEmpty: [^super getSelection].
        ^ self getBrowser selectedInterval!

----- Method: BrowserRequestor>>getSelector (in category 'requests') -----
getSelector
        | s |
        s := self getBrowser selectedMessageName.
        ^ s ifNil: [super getSelector] ifNotNil: [s]!

----- Method: BrowserRequestor>>getSelectorCollection (in category 'requests') -----
getSelectorCollection
        self caption: 'enter selector list'.
        ^ self getSymbolCollection !

----- Method: BrowserRequestor>>getSelectorName (in category 'requests') -----
getSelectorName
        ^ self getBrowser selectedMessageName!

----- Method: BrowserRequestor>>getSystemCategory (in category 'requests') -----
getSystemCategory
        ^ self getBrowser selectedSystemCategory!

----- Method: TextRequestor>>getCurrentText (in category 'request') -----
getCurrentText
        "returns the unnacepted text in the text morph"
        ^ self getModel codeTextMorph text!

----- Method: TextRequestor>>getModel (in category 'request') -----
getModel
        ^ model first!

----- Method: TextRequestor>>model: (in category 'accessing') -----
model: aModel
        model := WeakArray with: aModel!

----- Method: Object>>requestor (in category '*services-base') -----
requestor
        "returns the focused window's requestor"

        "SystemWindow focusedWindow ifNotNilDo: [:w | ^ w requestor]."

        "triggers an infinite loop"

        ^ Requestor default!

Object subclass: #ServiceAction
        instanceVariableNames: 'condition action requestor label shortLabel description id provider enabled'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base'!

!ServiceAction commentStamp: 'rr 7/10/2006 14:58' prior: 0!
ServiceAction are executable objects in various contexts.
They can be displayed as buttons or menu items or bounded to keyboard shortcuts.

ServiceActions are defined in methods in an instance of a ServiceProvider class (in the 'services' method category), using the following template:

serviceIdentifierAndMethodName
        ^ ServiceAction
                text: 'Menu item text'
                button: 'Button text'
                description: 'Longer text that appears in help balloons'
                action: [:r | "Code block fetching data from the requestor instance, r, that is passed to the block"]
               
or, alternatively:

serviceIdentifierAndMethodName
        ^ ServiceAction
                text: 'Menu item text'
                button: 'Button text'
                description: 'Longer text that appears in help balloons'
                action: [:r | "Code block fetching data from the requestor instance, r, that is passed to the block"]
                condition: [:r | "second block returning true if the service can be used at the time being, false otherwise. Data can still be fetched from the requestor instance"]
               
The method name in which the service is defined becomes its identifier. To build the hierarchy of services and to assign them to shortcuts, you will need to type this names in the relevant fields of the Services Browser.
               
Services are arranged in a hierarchy. and bound to keyboard shortcuts using the ServicesBrowser.
!

----- Method: ServiceAction class>>id:text:button:description:action: (in category 'instance creation') -----
id: aSymbol text: aStringOrBlock button: buttonString description: aString action: aBlock
        ^ self id: aSymbol
                text: aStringOrBlock
                button: buttonString
                description: aString
                action: aBlock
                condition: [:r | true]!

----- Method: ServiceAction class>>id:text:button:description:action:condition: (in category 'instance creation') -----
id: aSymbol text: aStringOrBlock button: buttonString description: aString action: aBlock condition: cBlock
        ^ (self new)
                id: aSymbol;
                text: aStringOrBlock;
                buttonLabel: buttonString;
                description: aString;
                action: aBlock;
                condition: cBlock;
                yourself!

----- Method: ServiceAction class>>initialize (in category 'class initialization') -----
initialize
        #(
        (inlineServicesInMenu true 'Inline the services the squeak menus')
        (useOnlyServicesInMenu false 'Use only services and not regular menu items')
        (useServicesInBrowserButtonBar false 'Use a service-based button bar'))
                do: [:tr |
                                Preferences
                                                addPreference: tr first
                                                categories: #(#services)
                                                default: tr second
                                                balloonHelp: tr third]
        !

----- Method: ServiceAction class>>text:button:description:action: (in category 'instance creation') -----
text: aStringOrBlock button: buttonString description: aString action: aBlock
        "use when id can be automatically generated"
        ^ self id: nil
                text: aStringOrBlock
                button: buttonString
                description: aString
                action: aBlock
                condition: [:r | true]!

----- Method: ServiceAction class>>text:button:description:action:condition: (in category 'instance creation') -----
text: aStringOrBlock button: buttonString description: aString action: aBlock condition: cBlock
        "use when id can be generated"
        ^ self
                id: nil
                text: aStringOrBlock
                button: buttonString
                description: aString
                action: aBlock
                condition: cBlock!

----- Method: ServiceAction class>>text:description:action: (in category 'instance creation') -----
text: textString description: aString action: aBlock
        "use when id can be generated"
        ^ self id: nil text: textString button: textString description: aString action: aBlock!

----- Method: ServiceAction>>action: (in category 'accessing') -----
action: aBlock
        action := aBlock!

----- Method: ServiceAction>>addPreference:category:selector: (in category 'preferences') -----
addPreference: name category: cat selector: sel
       
        ServicePreferences
                 addPreference: name
                 categories: {cat asSymbol. self providerCategory}
                 default: ''
                 balloonHelp:self description
                 projectLocal:false
                 changeInformee: self id -> sel
                 changeSelector: #serviceUpdate
                type: #String!

----- Method: ServiceAction>>buttonLabel (in category 'accessing') -----
buttonLabel
        ^ shortLabel
                ifNil: [self text]
                ifNotNil: [shortLabel ifEmpty: [self text] ifNotEmpty: [shortLabel]]!

----- Method: ServiceAction>>buttonLabel: (in category 'accessing') -----
buttonLabel: anObject
        shortLabel := anObject!

----- Method: ServiceAction>>categories (in category 'accessing') -----
categories
        ^ ServiceRegistry current categories select: [:e | e services includes: self]!

----- Method: ServiceAction>>condExecuteWith: (in category 'executing') -----
condExecuteWith: aRequestor
        self requestor: aRequestor.
        self executeCondition
                        ifTrue: [self execute]
                        ifFalse: [Beeper beep]!

----- Method: ServiceAction>>condition: (in category 'accessing') -----
condition: aBlock
        condition := aBlock!

----- Method: ServiceAction>>description (in category 'accessing') -----
description

        ^ description ifNil: [self text] ifNotNil: [description]!

----- Method: ServiceAction>>description: (in category 'accessing') -----
description: anObject
        description := anObject select: [:each | (each = Character cr) not]
                                                thenCollect: [:each | each = Character tab ifTrue: [Character space]
                                                                                                                        ifFalse: [each]].!

----- Method: ServiceAction>>execute (in category 'executing') -----
execute
        ^ action clone valueWithRequestor: World topRequestor!

----- Method: ServiceAction>>executeCondition (in category 'executing') -----
executeCondition
        ^ [condition clone valueWithRequestor: World topRequestor]
                on: Error
                do: [false]!

----- Method: ServiceAction>>id (in category 'accessing') -----
id
        ^id!

----- Method: ServiceAction>>id: (in category 'accessing') -----
id: aSymbol
        id := aSymbol!

----- Method: ServiceAction>>initialize (in category 'initialize-release') -----
initialize
        self
                action: [].
        self
                condition: [true].
        self text: 'no op'.
        self requestor: Requestor new.
        self id: #none.
        enabled := true!

----- Method: ServiceAction>>insertPreferences (in category 'preferences') -----
insertPreferences
        ServicePreferences
                addPreference: self id
                categories: (Array with: self providerCategory)
                default: true
                balloonHelp: self description
                projectLocal: false
                changeInformee: self id -> #updateEnable
                changeSelector: #serviceUpdate
                type: #Boolean!

----- Method: ServiceAction>>isCategory (in category 'testing') -----
isCategory
        ^ false!

----- Method: ServiceAction>>isEnabled (in category 'testing') -----
isEnabled
        ^ enabled!

----- Method: ServiceAction>>menuLabel (in category 'accessing') -----
menuLabel
        | l sh |
        l := self text.
        l size > 50 ifTrue: [l := (l first: 47), '...'].
        sh := self shortcut.
        sh := (sh isNil or: [sh isEmpty]) ifTrue: [''] ifFalse: [' (', sh, ')'].
        ^ l capitalized, sh!

----- Method: ServiceAction>>menuLabelNumbered: (in category 'accessing') -----
menuLabelNumbered: index
        | shorterLabel shortCut serviceNumberString |
        shorterLabel := self text.
        shorterLabel size > 50 ifTrue: [ shorterLabel := (shorterLabel first: 47) , '...' ].
        shortCut := self shortcut.
        shortCut := (shortCut isNil or: [ shortCut isEmpty ])
                ifTrue: [ String empty ]
                ifFalse: [ ' (' , shortCut , ')' ].
        serviceNumberString := index isZero
                ifTrue: [ String empty ]
                ifFalse: [ index asString , '.' ].
        ^ serviceNumberString , shorterLabel , shortCut!

----- Method: ServiceAction>>perform:orSendTo: (in category 'executing') -----
perform: selector orSendTo: otherTarget
        ^ self perform: selector!

----- Method: ServiceAction>>preferences (in category 'preferences') -----
preferences
        ^ {ServicePreferences preferenceAt: self shortcutPreference} select: [:e | e notNil]!

----- Method: ServiceAction>>printOn: (in category 'printing') -----
printOn: aStream
        super printOn: aStream.
        aStream
                 space ;
                 nextPutAll: id asString!

----- Method: ServiceAction>>provider (in category 'accessing') -----
provider
        ^ provider
                ifNil: [nil]
                ifNotNil: [provider new]!

----- Method: ServiceAction>>provider: (in category 'accessing') -----
provider: p
        provider := p!

----- Method: ServiceAction>>providerCategory (in category 'preferences') -----
providerCategory
        ^ provider name!

----- Method: ServiceAction>>requestor (in category 'accessing') -----
requestor
        ^requestor!

----- Method: ServiceAction>>requestor: (in category 'accessing') -----
requestor: anObject
        requestor := anObject!

----- Method: ServiceAction>>shortcut (in category 'preferences') -----
shortcut
        ^ ServicePreferences valueOfPreference: self shortcutPreference!

----- Method: ServiceAction>>shortcutPreference (in category 'preferences') -----
shortcutPreference
                ^ ('Shortcut for ', self id, ':') asSymbol!

----- Method: ServiceAction>>text (in category 'accessing') -----
text
        ^label isBlock ifTrue: [label  value: requestor] ifFalse: [label]!

----- Method: ServiceAction>>text: (in category 'accessing') -----
text: aString
        label := aString!

----- Method: ServiceAction>>updateEnable (in category 'preferences') -----
updateEnable
        enabled := ServicePreferences
                                valueOfPreference: self id
                                ifAbsent: [true]!

----- Method: ServiceAction>>updateShortcut (in category 'updating') -----
updateShortcut
        (self systemNavigation allImplementorsOf: #processService:newShortcut:)
                do: [:ref | | cls |
                        cls := ref actualClass.
                        cls isMeta ifTrue: [cls soleInstance processService: self newShortcut: self shortcut]].
        ServiceRegistry ifInteractiveDo: [self provider savePreferencesFor: self]!

ServiceAction subclass: #ServiceCategory
        instanceVariableNames: 'services'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base'!

!ServiceCategory commentStamp: 'rr 7/10/2006 15:06' prior: 0!
I represent a category of services that can be added to a menu.
I can be displayed as a menu or button bar containing my services.
I am also a subclass of ServiceAction, so I can form a subcategory of another service category.

Like services, I am created in methods of a ServiceProvider, in the 'services' method protocol.
The template to create a service category is the following:

methodNameAndServiceCategoryId
        ^ ServiceCategory
                text: 'Menu text'
                button: 'Button  text'
                description: 'Longer descriptive text appearing in help balloons'
       
To put services in a service category, you have to use the Service Browser, located in the word menu, under the 'Preferences and Services' menu item.
In it, you can look up for the name of your category, and enter service identifiers as children
of the category in the associatedd text field, separating them with spaces.!

----- Method: ServiceCategory class>>text:button:description: (in category 'instance creation') -----
text: aStringOrBlock button: buttonString description: aString
        "use when id can be generated"
        ^ self id: nil text: aStringOrBlock button: buttonString description: aString action: [] !

----- Method: ServiceCategory>>childrenPreferences (in category 'preferences') -----
childrenPreferences
                ^ ('Items in ', self id, ':') asSymbol!

----- Method: ServiceCategory>>enabledServices (in category 'accessing') -----
enabledServices
        ^ services
                select: [:e | e isEnabled]!

----- Method: ServiceCategory>>execute (in category 'executing') -----
execute
        "displays the subservices as a submenu"
        ServiceGui openMenuFor: self!

----- Method: ServiceCategory>>externalPreferences (in category 'preferences') -----
externalPreferences
        | p |
        p := ServicePreferences valueOfPreference: self childrenPreferences ifAbsent: [''].
        ^ (p findTokens: ' ') collect: [:e | e service]!

----- Method: ServiceCategory>>initialize (in category 'initialize-release') -----
initialize

        services := OrderedCollection new.
        super initialize.
       
!

----- Method: ServiceCategory>>insertPreferences (in category 'preferences') -----
insertPreferences
        super insertPreferences.
        ServicePreferences
                addPreference: self childrenPreferences
                categories: {
                                (#'-- menu contents --').
                                (self providerCategory)}
                default: ''
                balloonHelp: self description
                projectLocal: false
                changeInformee: self id -> #updateChildren
                changeSelector: #serviceUpdate
                type: #String!

----- Method: ServiceCategory>>isCategory (in category 'testing') -----
isCategory
        ^ true!

----- Method: ServiceCategory>>newChildren (in category 'preferences') -----
newChildren
        | s |
        s := ServicePreferences valueOfPreference: self childrenPreferences.
        ^ (s findTokens: ' ') collect: [:str | str serviceOrNil]!

----- Method: ServiceCategory>>newChildrenValid (in category 'preferences') -----
newChildrenValid
        | s |
        s := ServicePreferences valueOfPreference: self childrenPreferences.
        ^ (s findTokens: ' ') allSatisfy: [:str |
                str serviceOrNil
                        ifNil: [ServiceRegistry ifInteractiveDo:
                                                [self inform: str, ' is not a valid service name'].
                                        false]
                        ifNotNil: [true]]!

----- Method: ServiceCategory>>prefServices (in category 'preferences') -----
prefServices
        | s |
        s := ServicePreferences valueOfPreference: self childrenPreferences.
        ^ (s findTokens: ' ') collect: [:str | str service]!

----- Method: ServiceCategory>>replaceChildren (in category 'preferences') -----
replaceChildren
        ServiceRegistry ifInteractiveDo: [services
                do: [:s | s provider
                                ifNotNil: [:p | p class removeSelector: (self id , s id) asSymbol]]].
        services := self newChildren.
        services
                do: [:e |
                        (ServicePreferences preferenceAt: e shortcutPreference)
                                ifNotNil: [:p | p categoryList: {'-- keyboard shortcuts --'. self id asString}].
                        ServiceRegistry
                                ifInteractiveDo: [self provider savePreferencesFor: self]]!

----- Method: ServiceCategory>>requestor: (in category 'accessing') -----
requestor: aRequestor
        super requestor: aRequestor.
        self services do: [:s | s requestor: aRequestor]!

----- Method: ServiceCategory>>services (in category 'accessing') -----
services
        ^services!

----- Method: ServiceCategory>>updateChildren (in category 'preferences') -----
updateChildren

        self newChildrenValid
                ifTrue: [self replaceChildren].
        "PreferenceBrowserMorph updateBrowsers."
        ServiceGui updateBar: self!

Object subclass: #ServiceGui
        instanceVariableNames: 'menu bar service n'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-GUI'!
ServiceGui class
        instanceVariableNames: 'bars'!

!ServiceGui commentStamp: 'rr 7/10/2006 15:29' prior: 0!
I abstract all the UI-related behaviors for the services framework.
In the future I could be changed to be compatible with ToolBuilder!
ServiceGui class
        instanceVariableNames: 'bars'!

----- Method: ServiceGui class>>bars (in category 'registering button bars') -----
bars
        ^ bars!

----- Method: ServiceGui class>>browser:classCategoryMenu: (in category 'hooks') -----
browser: b classCategoryMenu: aMenu
        ^ (self new  for:b  id:#browserClassCategoryMenu)  inlineInMenu:aMenu!

----- Method: ServiceGui class>>browser:classMenu: (in category 'hooks') -----
browser: b classMenu: aMenu
        ^ (self new  for:b  id:#browserClassMenu)  inlineInMenu:aMenu!

----- Method: ServiceGui class>>browser:codePaneMenu: (in category 'hooks') -----
browser: b codePaneMenu: aMenu

        ^(self new for: b id: #browserCodePaneMenu) inlineInMenu: aMenu!

----- Method: ServiceGui class>>browser:messageCategoryMenu: (in category 'hooks') -----
browser: b messageCategoryMenu: aMenu
        ^ (self new  for:b  id:#browserMethodCategoryMenu)  inlineInMenu:aMenu!

----- Method: ServiceGui class>>browser:messageListMenu: (in category 'hooks') -----
browser: aBrowser messageListMenu: aMenu
        ^ (self new
                for: aBrowser
                id: #browserMethodMenu) inlineInMenu: aMenu!

----- Method: ServiceGui class>>browserButtonRow: (in category 'hooks') -----
browserButtonRow: aBrowser
        ^ (self new for: aBrowser id: #browserButtonBar) buildButtonBar !

----- Method: ServiceGui class>>browserButtonRow:inlinedIn: (in category 'hooks') -----
browserButtonRow: aBrowser inlinedIn: row
        | bar |
        self buttonBarServices
                ifTrue: [bar := (self new for: aBrowser id: #browserButtonBar) buildButtonBar.
                        row addMorphBack: bar].
        ^ row!

----- Method: ServiceGui class>>buttonBarServices (in category 'preferences') -----
buttonBarServices
        ^ ServicePreferences valueOfPreference: #useServicesInBrowserButtonBar !

----- Method: ServiceGui class>>initialize (in category 'registering button bars') -----
initialize
        bars := OrderedCollection new.
        (TheWorldMenu respondsTo: #registerOpenCommand:)
                ifTrue: [TheWorldMenu unregisterOpenCommand: 'Services Browser'.
                        TheWorldMenu registerOpenCommand: {'Services Browser'. {PreferenceBrowser. #openForServices}}]!

----- Method: ServiceGui class>>inlineServices (in category 'preferences') -----
inlineServices
        ^ ServicePreferences valueOfPreference: #inlineServicesInMenu !

----- Method: ServiceGui class>>onlyServices (in category 'preferences') -----
onlyServices
        ^ ServicePreferences valueOfPreference: #useOnlyServicesInMenu!

----- Method: ServiceGui class>>openMenuFor: (in category 'opening menus') -----
openMenuFor: aServiceCategory
        (self new menuFor: aServiceCategory) invokeModal!

----- Method: ServiceGui class>>registerBar:for: (in category 'registering button bars') -----
registerBar: aBar for: service
       
        self bars removeAllSuchThat: [:a | a value isNil].
        self bars add: (WeakValueAssociation key: service value: aBar).!

----- Method: ServiceGui class>>updateBar: (in category 'registering button bars') -----
updateBar: cat
       
        self bars
                select: [:assoc | (assoc key id = cat id) & assoc value notNil]
                thenDo: [:assoc | | newBar |
                        cat requestor: assoc key requestor.
                        newBar := self new buttonBarFor: cat.
                        assoc value removeAllMorphs.
                        newBar submorphsDo: [:m | assoc value addMorphBack: m]]!

----- Method: ServiceGui class>>updateBars (in category 'registering button bars') -----
updateBars
       
        self bars do: [:assoc | | oldCat cat newBar bar |
                (bar := assoc value) ifNotNil: [
                        oldCat := assoc key.
                        cat := oldCat id service.
                        cat requestor: oldCat requestor.
                        newBar := self new buttonBarFor: cat.
                        bar removeAllMorphs.
                        newBar submorphsDo: [:m | bar addMorphBack: m]].
                ]!

----- Method: ServiceGui class>>updateMenu:forModel:selector: (in category 'hooks') -----
updateMenu: aMenu forModel: aModel selector: selector
        ('codePane*' match: selector) ifTrue: [
        (self new for: aModel id: #codeSelectionRefactorings) inlineInMenu: aMenu].
        ^ aMenu
        !

----- Method: ServiceGui class>>worldMenu: (in category 'hooks') -----
worldMenu: aMenu
        ^ (self new for: aMenu id: #world) inlineInMenu: aMenu!

----- Method: ServiceGui>>bar (in category 'accessing') -----
bar
        ^ bar!

----- Method: ServiceGui>>buildButtonBar (in category 'building') -----
buildButtonBar
        bar := self buttonBarFor: service.
        self class registerBar: bar for: service.
        ^ bar!

----- Method: ServiceGui>>buttonBarFor: (in category 'servicecategory') -----
buttonBarFor: aServiceCategory
        self styleBar: self bar.
        aServiceCategory enabledServices
                do: [:each | self bar
                                addMorphBack: (self buttonFor: each)].
        ^ self bar!

----- Method: ServiceGui>>buttonFor: (in category 'services') -----
buttonFor: aService
        ^ aService isCategory ifTrue: [self buttonForCategory: aService]
                                                        ifFalse: [self buttonForAction: aService]!

----- Method: ServiceGui>>buttonForAction: (in category 'serviceactions') -----
buttonForAction: aService
        "see getstate for availability?"

        | aButton |
        aButton := PluggableButtonMorph
                                on: aService
                                getState: nil
                                action: #execute.
        self styleButton: aButton.
        aButton
                label: aService buttonLabel;
                setBalloonText: aService description.
        ^aButton!

----- Method: ServiceGui>>buttonForCategory: (in category 'servicecategory') -----
buttonForCategory: aService
        "see getstate for availability?"

        | aButton |
        aButton := PluggableButtonMorph
                                on: [:button | aService requestor: button requestor.
                                                                self class openMenuFor: aService]
                                getState: nil
                                action: #value:.
        aButton arguments: (Array with: aButton).
        self styleButton: aButton.
        aButton
                label: aService buttonLabel.
        ^aButton!

----- Method: ServiceGui>>for:id: (in category 'initialization') -----
for: caller id: id
        service := id service.
        caller ifNotNil: [service requestor: caller requestor]!

----- Method: ServiceGui>>initialize (in category 'initialization') -----
initialize
        super initialize.
        menu := OrderedCollection new.
        bar := AlignmentMorph newRow.
        n := OrderedCollection with: 0!

----- Method: ServiceGui>>inlineInMenu: (in category 'building') -----
inlineInMenu: aMenu
        ^ self class inlineServices
                ifTrue: [self inlineInMenu: aMenu for: service]
                ifFalse: [aMenu]!

----- Method: ServiceGui>>inlineInMenu:for: (in category 'servicecategory') -----
inlineInMenu: aMenu for: aServiceCategory
        menu addLast: aMenu.
        aServiceCategory enabledServices
                do: [:each | self menuItemFor: each].
        ^ self popMenu!

----- Method: ServiceGui>>menu (in category 'accessing') -----
menu
        ^ menu last!

----- Method: ServiceGui>>menuFor: (in category 'servicecategory') -----
menuFor: aServiceCategory
        | submenu |
        submenu := self subMenuFor: aServiceCategory.
        ^ submenu
                addTitle: (aServiceCategory menuLabel)!

----- Method: ServiceGui>>menuItemFor: (in category 'services') -----
menuItemFor: aService
        [aService isCategory ifTrue: [self menuItemForCategory: aService]
                                                        ifFalse: [self menuItemForAction: aService]]
                on: Error
                do: [:er | (self confirm: 'menuItemFor: error. debug?') ifTrue: [er signal]]!

----- Method: ServiceGui>>menuItemForAction: (in category 'serviceactions') -----
menuItemForAction: aServiceAction
        "Returns a menuItem triggering self"
        self menu
                add: (aServiceAction menuLabelNumbered: self n)
                target: aServiceAction
                selector: #execute.
        Smalltalk isMorphic ifTrue: [
                self menu lastItem isEnabled: aServiceAction executeCondition.
                self menu balloonTextForLastItem: aServiceAction description]!

----- Method: ServiceGui>>menuItemForCategory: (in category 'servicecategory') -----
menuItemForCategory: aServiceCategory
        "Returns a menuItem triggering self"
        | submenu |
        submenu := self subMenuFor: aServiceCategory.
        self menu add: (aServiceCategory menuLabelNumbered: self n) subMenu: submenu!

----- Method: ServiceGui>>n (in category 'servicecategory') -----
n
        ^ n last!

----- Method: ServiceGui>>n: (in category 'servicecategory') -----
n: nn
        n removeLast.
        n addLast: nn!

----- Method: ServiceGui>>popMenu (in category 'servicecategory') -----
popMenu
        | aMenu |
        aMenu := menu removeLast.
        n removeLast.
        self styleMenu: aMenu.
        ^ aMenu!

----- Method: ServiceGui>>pushMenu (in category 'servicecategory') -----
pushMenu
        menu addLast: MenuMorph new.
        n addLast: 0!

----- Method: ServiceGui>>styleBar: (in category 'styling') -----
styleBar: aBar
        aBar setNameTo: 'button bar'.
        aBar beSticky;
                 hResizing: #spaceFill;
                wrapCentering: #center;
                cellPositioning: #leftCenter;
                clipSubmorphs: true;
                cellInset: 0;
                color: Preferences defaultWindowColor.!

----- Method: ServiceGui>>styleButton: (in category 'styling') -----
styleButton: aButton
        aButton color: Color transparent;
        onColor: Color transparent offColor: Color transparent;
       
        borderStyle: (BorderStyle width: 1 color: Color gray);
        askBeforeChanging: true;
        clipSubmorphs: true;
        hResizing: #spaceFill;
        vResizing: #spaceFill.
        ^ self!

----- Method: ServiceGui>>styleMenu: (in category 'styling') -----
styleMenu: aMenu
        "gradient, etc ..?"
        "aMenu color: Color white;
               
                borderStyle: (BorderStyle width: 1 color: Color gray);
                 clipSubmorphs: true;
                 addDropShadow;
               
                shadowColor: (TranslucentColor
                                r: 0.0
                                g: 0.0
                                b: 0.0
                                alpha: 0.666);
                 shadowOffset: 1 @ 1"!

----- Method: ServiceGui>>subMenuFor: (in category 'servicecategory') -----
subMenuFor: aServiceCategory
        self pushMenu.
        aServiceCategory enabledServices
                ifEmpty: [self menuItemFor: ServiceAction new].
        aServiceCategory enabledServices
                doWithIndex: [:each :i | self n: i. self menuItemFor: each].
        ^ self popMenu!

Object subclass: #ServiceProvider
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base'!

!ServiceProvider commentStamp: 'rr 7/10/2006 15:08' prior: 0!
A ServiceProvider references services that are relevant to a given application.

Each application that wishes to use the Services framework must subclass a ServiceProvider.
This class must define a 'services' method category.
Each method implemented in this category will be automatically called by the framework.
Each of these method should be a unary message (taking no argument), and return a fully initialised instance of ServiceAction or ServiceCategory. There are three possible patterns:

1)

serviceIdentifierAndMethodName
        ^ ServiceAction
                text: 'Menu item text'
                button: 'Button text'
                description: 'Longer text that appears in help balloons'
                action: [:r | "Code block fetching data from the requestor instance, r, that is passed to the block"]
               

2)

serviceIdentifierAndMethodName
        ^ ServiceAction
                text: 'Menu item text'
                button: 'Button text'
                description: 'Longer text that appears in help balloons'
                action: [:r | "Code block fetching data from the requestor instance, r, that is passed to the block"]
                condition: [:r | "second block returning true if the service can be used at the time being, false otherwise. Data can still be fetched from the requestor instance"]
               
3)

methodNameAndServiceCategoryId
        ^ ServiceCategory
                text: 'Menu text'
                button: 'Button  text'
                description: 'Longer descriptive text appearing in help balloons'
       

The organisation of services into categories, and the services bound to keyboard shortcuts are
specified using the Services Browser (see the comment on the class ServicesPreferences for more details). When editing preferences, they are saved as methods on the ServiceProvider, all defined
in the 'saved preferences' method category. Each of thesse methods stores preferences that the provider can replay.
!

ServiceProvider subclass: #BrowserProvider
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-Providers'!

!BrowserProvider commentStamp: 'rr 7/10/2006 15:17' prior: 0!
I define the default categories of services dealing with browsing:
- the class category menu (service identifier: browserClassCategoryMenu)
- the class menu (browserClassMenu)
- the method category menu (browserMethodCategoryMenu)
- the browser method menu (browserMethodMenu)
- the browser button bar (browserButtonBar)
- the browser code pane/selection menu (browserCodePaneMenu)!

----- Method: BrowserProvider class>>initialize (in category 'initialize-release') -----
initialize
        ServiceRegistry current buildProvider: self new!

----- Method: BrowserProvider>>browser (in category 'services') -----
browser
        ^ ServiceCategory  text: 'Browser'
                                        button: 'browser'
                                        description: 'The browser menus'!

----- Method: BrowserProvider>>browserButtonBar (in category 'services') -----
browserButtonBar
        ^ ServiceCategory
                 text:'button bar'
                 button:'button'
                 description:'the browser button bar'!

----- Method: BrowserProvider>>browserClassCategoryMenu (in category 'services') -----
browserClassCategoryMenu
        ^ ServiceCategory
                 text:'Class Category'
                 button:'class cat'
                 description:'The browser class category menu'!

----- Method: BrowserProvider>>browserClassMenu (in category 'services') -----
browserClassMenu
        ^ ServiceCategory
                 text:'Class'
                 button:'class'
                 description:'The browser class menu'!

----- Method: BrowserProvider>>browserClassMenushortcut (in category 'saved preferences') -----
browserClassMenushortcut
        ^ #(#'Shortcut for browserClassMenu:' '' 1000 )!

----- Method: BrowserProvider>>browserCodePaneMenu (in category 'services') -----
browserCodePaneMenu
        ^ ServiceCategory text: 'Code Pane'
                                                button: 'pane'
                                                description: 'The browser code pane menu'!

----- Method: BrowserProvider>>browserMethodCategoryMenu (in category 'services') -----
browserMethodCategoryMenu
        ^ ServiceCategory
                 text:'Method Category'
                 button:'method cat'
                 description:'The browser method menu'!

----- Method: BrowserProvider>>browserMethodMenu (in category 'services') -----
browserMethodMenu
        ^ ServiceCategory
                 text:'Method'
                 button:'method'
                 description:'The browser method menu'!

----- Method: BrowserProvider>>browserMethodMenushortcut (in category 'saved preferences') -----
browserMethodMenushortcut
        ^ #(#'Shortcut for browserMethodMenu:' '' 1000 )!

----- Method: ServiceProvider class>>newProviderFor: (in category 'provider creation') -----
newProviderFor: packageName
        | cls clsName |
        clsName := ((packageName copyWithout: $-) , 'ServiceProvider') asSymbol.
        cls := self subclass: clsName
                instanceVariableNames: ''
                classVariableNames: ''
                poolDictionaries: ''
                category: packageName.
        cls class compile: 'initialize
        ServiceRegistry buildProvider: self new' classified: 'initialization'.
        ^ cls!

----- Method: ServiceProvider class>>registeredProviders (in category 'accessing') -----
registeredProviders
        ^ self allSubclasses collect: [:each | each new]!

----- Method: ServiceProvider>>performAndSetId: (in category 'accessing') -----
performAndSetId: aSymbol
        | service |
        service := self perform: aSymbol.
        service id: aSymbol.
        ^service!

----- Method: ServiceProvider>>registeredServices (in category 'accessing') -----
registeredServices
       
        ^ self services collect: [:each | self performAndSetId: each]!

----- Method: ServiceProvider>>replayPreferences (in category 'persistence') -----
replayPreferences
        ServicePreferences replayPreferences: self savedPreferences!

----- Method: ServiceProvider>>savePreferencesFor: (in category 'persistence') -----
savePreferencesFor: aService
       
        "pref := ServicePreferences preferenceAt: aService shortcutPreference.
        strm := WriteStream with: ''.
        strm nextPutAll: aService id;
                 nextPutAll: 'shortcut';
                 cr;
                 tab;
                 nextPutAll: '^ ';
                 nextPutAll: {pref name. pref preferenceValue. 1000} storeString.
        self class compileSilently: strm contents classified: 'saved preferences'."
        aService isCategory
                ifTrue: [aService externalPreferences
                                doWithIndex: [:e :i | | strm |
                                        strm := WriteStream with: aService id asString.
                                        strm nextPutAll: e id asString;
                                                 cr;
                                                 tab;
                                                 nextPutAll: '^ ';
                                                 nextPutAll: {aService childrenPreferences. e id. i} storeString.
                                        e provider class compileSilently: strm contents classified: 'saved preferences']]!

----- Method: ServiceProvider>>savedPreferences (in category 'persistence') -----
savedPreferences
         ^ (self class organization listAtCategoryNamed: #'saved preferences')
                        collect: [:e | self perform: e]!

----- Method: ServiceProvider>>services (in category 'accessing') -----
services
        ^ self class organization listAtCategoryNamed: #services!

ServiceProvider subclass: #WorldMenuProvider
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base-Providers'!

!WorldMenuProvider commentStamp: 'rr 7/10/2006 15:19' prior: 0!
I define services and categories:
- The world menu category (identifier:  world), where services and categories can be put to be displayed in the world menu.
- The preferencesMenu category, where services about services and preferences can be put
- th open menu!

----- Method: WorldMenuProvider class>>initialize (in category 'initialize-release') -----
initialize
        ServiceRegistry current buildProvider: self new!

----- Method: WorldMenuProvider>>browserMethodMenucreateNewService (in category 'saved preferences') -----
browserMethodMenucreateNewService
        ^ #(#'Items in browserMethodMenu:' #createNewService 1 )!

----- Method: WorldMenuProvider>>closeTopWindow (in category 'services') -----
closeTopWindow
        ^ ServiceAction
                text: 'Close top window'
                button: 'close window'
                description: 'Closes the focused window'
                action: [:r | SystemWindow topWindow delete]!

----- Method: WorldMenuProvider>>convertOpenCommand: (in category 'service registering') -----
convertOpenCommand: array
        | description |
        description := array size > 2
                                ifTrue: [array third]
                                ifFalse: ['none available'].
        ^ServiceAction
                id: array first asSymbol
                text: array first
                button: array first
                description: description
                action: [array second first perform: array second second]!

----- Method: WorldMenuProvider>>createNewService (in category 'services') -----
createNewService
        ^ ServiceAction
                text: 'Create new service'
                button: 'new service'
                description: 'Define a new service provided by this package'
                action: [:r | | s p |
                        s := r caption: 'enter service identifier'; getSymbol.
                        p := r getPackageProvider.
                        p compile: s, '
        ^ ServiceAction
                "Open the service browser to set the menu position and the keyboard shortcut"
                text: ''fill menu label''
                button: ''short button text''
                description: ''longer text for balloon help''
                action: [:r | "action block"]
                condition: [:r | "optional condition block"]' classified: 'services'.
                        r getBrowser browseReference: (MethodReference class: p selector: s)]!

----- Method: WorldMenuProvider>>helpOnServices (in category 'services') -----
helpOnServices
        ^ ServiceAction
                text: 'Help on Services'
                button: 'services help'
                description: 'Introductory text about services'
                action: [StringHolder new contents: self servicesHelpText; openLabel: 'Introduction to Services'].!

----- Method: WorldMenuProvider>>nextWindow (in category 'services') -----
nextWindow
        ^ ServiceAction text: 'Switch to next window' button: 'next window' description: 'Switches to the next window' action: [:r | SystemWindow sendTopWindowToBack]!

----- Method: WorldMenuProvider>>openMenu (in category 'services') -----
openMenu
        ^ ServiceCategory text: 'Open' button: 'open' description: 'The open menu'!

----- Method: WorldMenuProvider>>preferencesBrowser (in category 'services') -----
preferencesBrowser
        ^ ServiceAction text: 'Preference Browser' button: 'pref. browser' description: 'Open the preference browser to edit various Squeak settings' action: [PreferenceBrowser open].!

----- Method: WorldMenuProvider>>preferencesMenu (in category 'services') -----
preferencesMenu
        ^ ServiceCategory text: 'Preferences & Services' button: 'preferences' description: 'Menu related to editing preferences'!

----- Method: WorldMenuProvider>>preferencesMenuhelpOnServices (in category 'saved preferences') -----
preferencesMenuhelpOnServices
        ^ #(#'Items in preferencesMenu:' #helpOnServices 3 )!

----- Method: WorldMenuProvider>>preferencesMenupreferencesBrowser (in category 'saved preferences') -----
preferencesMenupreferencesBrowser
        ^ #(#'Items in preferencesMenu:' #preferencesBrowser 1 )!

----- Method: WorldMenuProvider>>preferencesMenurebuildRegistry (in category 'saved preferences') -----
preferencesMenurebuildRegistry
        ^ #(#'Items in preferencesMenu:' #rebuildRegistry 4 )!

----- Method: WorldMenuProvider>>preferencesMenuservicesBrowser (in category 'saved preferences') -----
preferencesMenuservicesBrowser
        ^ #(#'Items in preferencesMenu:' #servicesBrowser 2 )!

----- Method: WorldMenuProvider>>preferencesMenushortcut (in category 'saved preferences') -----
preferencesMenushortcut
        ^ #(#'Shortcut for preferencesMenu:' '' 1000 )!

----- Method: WorldMenuProvider>>rebuildRegistry (in category 'services') -----
rebuildRegistry
        ^ ServiceAction text: 'Rebuild service registry' button: 'rebuild registry' description: 'Rebuilds the service registry to scan for newly defined services' action: [ServiceRegistry rebuild].!

----- Method: WorldMenuProvider>>servicesBrowser (in category 'services') -----
servicesBrowser
        ^ ServiceAction text: 'Services Browser' button: 'services' description: 'Open a preference browser to edit several Squeak menus' action: [PreferenceBrowser openForServices].!

----- Method: WorldMenuProvider>>servicesHelpText (in category 'accessing') -----
servicesHelpText
        ^ '
        This is an overview of the main concepts of the services framework. More details are available in class comments. The aim is to help you defining services step by step. The three main classes are:

-ServiceAction
-ServiceCategory
-ServiceProvider

Alongside them, a tool to use is the Services Browser. It can be found in the world menu, under the ''Preferences & Services'' menu heading (in which you found this text).
       
        ServiceAction are executable objects in various contexts.
They can be displayed as buttons or menu items or bounded to keyboard shortcuts.

        ServiceCategory are categories of services. They are also services, so a ServiceCategory can be included in another, forming a tree of Services. ServiceCategories can be displayed with menus, or button bars.
       
        A ServiceProvider references services that are relevant to a given application.
Each application that wishes to use the Services framework must subclass a ServiceProvider.
This class must define a ''services'' method category.
Each method implemented in this category will be automatically called by the framework.
Each of these method should be a unary message (taking no argument), and return a fully initialised instance of ServiceAction or ServiceCategory. There are three possible patterns:

1)
serviceIdentifierAndMethodName
        ^ ServiceAction
                text: ''Menu item text''
                button:''Button text''
                description: ''Longer text that appears in help balloons''
                action: [:r | "Code block fetching data from the requestor instance, r, that is passed to the block"]
               
2)
serviceIdentifierAndMethodName
        ^ ServiceAction
                text: ''Menu item text''
                button: ''Button text''
                description: ''Longer text that appears in help balloons''
                action: [:r | "Code block fetching data from the requestor instance, r, that is passed to the block"]
                condition: [:r | "second block returning true if the service can be used at the time being, false otherwise. Data can still be fetched from the requestor instance"]
               
3)
methodNameAndServiceCategoryId
        ^ ServiceCategory
                text: ''Menu text''
                button: ''Button  text''
                description: ''Longer descriptive text appearing in help balloons''

The block given to the ServiceActions can take an instance of the Requestor class as parameter. You can fetch data from these. The generic format is to call methods starting with ''get'' on the requestor, like getClass, getMessageName for services related to the browser.

The organisation of services into categories, and the services bound to keyboard shortcuts are
specified using the Services Browser, based on the Preference Browser by Hernan Tylim. When editing preferences, they are saved as methods on the ServiceProvider, all defined in the ''saved preferences'' method category.

When opening the Services Browser you see a list of preference categories on the left, and the preferences inside this category on the right. The main preference categories for services are:

-- keyboard shortcuts -- : several text preferences, one per keyboard shortcuts. To edit them,  enter a service identifier (equal to the method name under which it is defined in its ServiceProvider), and accept with alt-s or enter

-- menu contents -- : All the service categories in the image have a text preference under here. To edit it, enter the services identifiers you wish to put in this category, separating them with a single space character. The order is important: it defines the order of the items in menus.

-- settings -- : general boolean preferences.

Then there is a preference category for each provider in the image. Under each, you will find:
A boolean preference for each service in the image. If it is false, the service will not appear in menus.
The text preference for each service category defined by the service provider. This is the same as the one appearing in the menu contents preference category.

Some identifiers of categories already appearing in the UI are:
- world : the world menu
- preferencesMenu
- browserClasssCategoryMenu
- browserClassMenu
- browserMethodCategoryMenu
- browserMethodMenu
- browserCodePaneMenu
- browserButtonBar

After editing these preferences to match the services and categories you defined for your application, you should be done.

        Romain Robbes'!

----- Method: WorldMenuProvider>>world (in category 'services') -----
world
        ^ ServiceCategory text: 'World' button: 'world' description: 'The world menu'!

----- Method: WorldMenuProvider>>worldpreferencesMenu (in category 'saved preferences') -----
worldpreferencesMenu
        ^ #(#'Items in world:' #preferencesMenu 1 )!

----- Method: WorldMenuProvider>>worldshortcut (in category 'saved preferences') -----
worldshortcut
        ^ #(#'Shortcut for world:' '' 1000 )!

Object subclass: #ServiceRegistry
        instanceVariableNames: 'services interactive'
        classVariableNames: 'Current'
        poolDictionaries: ''
        category: 'Services-Base'!

!ServiceRegistry commentStamp: 'rr 7/10/2006 15:10' prior: 0!
The ServiceRegistry is the repository in which services are stored. They are stored in
a dictionary, and keyed by their identifier (which is the name of the method they were defined in).

The registry handles the intialization, building and referencing processes as well.!

----- Method: ServiceRegistry class>>current (in category 'as yet unclassified') -----
current
        ^ Current ifNil: [Current := self new]!

----- Method: ServiceRegistry class>>ifInteractiveDo: (in category 'as yet unclassified') -----
ifInteractiveDo: aBlock
        self current isInteractive ifTrue: [aBlock value]!

----- Method: ServiceRegistry class>>initialize (in category 'as yet unclassified') -----
initialize

        self rebuild.
        SystemChangeNotifier uniqueInstance
                notify: self
                ofSystemChangesOfItem: #method
                using: #methodChanged:
                !

----- Method: ServiceRegistry class>>methodChanged: (in category 'as yet unclassified') -----
methodChanged: event
        self ifInteractiveDo: [
        | cls |
        cls := event itemClass.
        ((event changeKind = #removed) not & (cls inheritsFrom: ServiceProvider) and: [cls new services includes: event itemSelector])
                ifTrue: [[self current addService: (cls new performAndSetId: event itemSelector)
                                        provider: cls]
                        on: Error do: [self inform: 'Service format seems to be incorrect']]]!

----- Method: ServiceRegistry class>>rebuild (in category 'as yet unclassified') -----
rebuild
        | old |
        old := Current.
        [Current := self new.
        Current build]
                on: Error
                do: [:err | (self confirm: 'An error occured during build.
                                                                Debug it?')
                                ifTrue: [err signal].
                                Current := old]!

----- Method: ServiceRegistry>>addService:provider: (in category 'building') -----
addService: aService provider: p
        services  at:aService id  put:aService.
        aService provider: p.
        aService insertPreferences
!

----- Method: ServiceRegistry>>beNotInteractiveDuring: (in category 'building') -----
beNotInteractiveDuring: aBlock
        interactive := false.
        aBlock value.
        interactive := true!

----- Method: ServiceRegistry>>build (in category 'building') -----
build
        "ServicePreferences wipe."
        self
                beNotInteractiveDuring: [
                        | pr |
                        ServiceProvider registeredProviders
                                do: [:p | p registeredServices
                                                do: [:each | self addService: each provider: p class]].
                        pr := ServiceProvider registeredProviders
                                                gather: [:p | p savedPreferences].
                        ServicePreferences replayPreferences: pr.
                        ].
        ServiceGui updateBars.
        ServiceShortcuts setPreferences!

----- Method: ServiceRegistry>>buildProvider: (in category 'building') -----
buildProvider: p
        self beNotInteractiveDuring: [
                p registeredServices do: [:each | self addService: each provider: p class].
                p replayPreferences]
        !

----- Method: ServiceRegistry>>categories (in category 'accessing') -----
categories
        ^ self serviceCollection select: [:s | s isCategory]!

----- Method: ServiceRegistry>>initialize (in category 'initialize-release') -----
initialize
        services := Dictionary new.
        interactive := true!

----- Method: ServiceRegistry>>isInteractive (in category 'accessing') -----
isInteractive
        ^ interactive!

----- Method: ServiceRegistry>>serviceCollection (in category 'accessing') -----
serviceCollection
        ^ services asArray!

----- Method: ServiceRegistry>>serviceWithId: (in category 'accessing') -----
serviceWithId: aSymbol
        ^ services at: aSymbol
                                ifAbsent: [nil]!

----- Method: ServiceRegistry>>services (in category 'accessing') -----
services
        ^ self serviceCollection reject: [:s | s isCategory]!

Object subclass: #ServiceShortcuts
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base'!
ServiceShortcuts class
        instanceVariableNames: 'map'!

!ServiceShortcuts commentStamp: 'rr 7/10/2006 15:14' prior: 0!
A data structures implementing a simple form of keyboard shortucts is defined on the class side.

Available keyboard shortcuts are:

command-0 to command-9 (command is also called alt on some systems).
control-0 to control-0
command-control-0 to command-control-9 (command is also alt)
control-command-left arrow
control-command-up arrow
control-command-right arrow
control-command-down arrow

Using the Services Browser (see class ServicePreferences), these shortcuts can be bound to service identifiers.!
ServiceShortcuts class
        instanceVariableNames: 'map'!

----- Method: ServiceShortcuts class>>arrowShortcut:event: (in category 'as yet unclassified') -----
arrowShortcut: str event: event
        | key s |
        key := event keyCharacter caseOf: {
                                [Character arrowDown] -> ['down'].
                                [Character arrowUp] -> ['up'].
                                [Character arrowLeft] -> ['left'].
                                [Character arrowRight] -> ['right']}.
        s := self map
                                at: str , key
                                ifAbsent: [^ self].
        s serviceOrNil
                ifNotNil: [:sv | sv execute.
        event wasHandled: true]!

----- Method: ServiceShortcuts class>>changeShortcut:to: (in category 'as yet unclassified') -----
changeShortcut: shortcut to: aString
        aString isBlock ifTrue: [^self map at: shortcut put: aString].
        (aString beginsWith: '[') ifTrue: [^self map at: shortcut put: aString].
        aString isEmpty ifTrue: [self map removeKey: shortcut ifAbsent: []]
                                ifFalse: [self map at: shortcut put: aString]!

----- Method: ServiceShortcuts class>>handleKeystroke: (in category 'as yet unclassified') -----
handleKeystroke: event
        [event isKeystroke
                ifTrue: [self process: event]]
                on: Error
                do: [:e | (self confirm: 'shortcut error. debug?') ifTrue: [e signal]]!

----- Method: ServiceShortcuts class>>insertPrefShortcut: (in category 'as yet unclassified') -----
insertPrefShortcut: short
                                        ServicePreferences
                                                addPreference: short
                                                categories: #('-- keyboard shortcuts --' )
                                                default: ''
                                                balloonHelp: 'enter a service id to bind it to this shortcut'
                                                projectLocal: false
                                                changeInformee: [self
                                                                changeShortcut: short
                                                                to: (ServicePreferences valueOfPreference: short)]
                                                changeSelector: #value
                                                type: #String!

----- Method: ServiceShortcuts class>>map (in category 'as yet unclassified') -----
map
        ^ map ifNil: [map := Dictionary new]!

----- Method: ServiceShortcuts class>>process: (in category 'as yet unclassified') -----
process: event
        event keyCharacter isDigit
                ifTrue: [event commandKeyPressed & event controlKeyPressed
                                ifTrue: [^ self shortcut: 'ctrl-cmd-' event: event].
                        event commandKeyPressed
                                ifTrue: [^ self shortcut: 'cmd-' event: event].
                        event controlKeyPressed
                                ifTrue: [^ self shortcut: 'ctrl-' event: event]].
        ({Character arrowUp. Character arrowDown. Character arrowLeft. Character arrowRight} includes: event keyCharacter)
                ifTrue: [event commandKeyPressed & event controlKeyPressed
                                ifTrue: [^ self arrowShortcut: 'ctrl-cmd-' event: event].
                        ]!

----- Method: ServiceShortcuts class>>setPreferences (in category 'as yet unclassified') -----
setPreferences
        | mm |
        mm := self map copy.
        (0 to: 9)
                do: [:i | #('ctrl-' 'cmd-' 'ctrl-cmd-' )
                                do: [:str |
                                        | short |
                                        short := (str , i asString) asSymbol.
                                        self insertPrefShortcut: short]].
        #(#up #down #left #right )
                do: [:s |
                        self insertPrefShortcut: ('ctrl-cmd-' , s) asSymbol.].
        mm
                keysAndValuesDo: [:k :v | ServicePreferences setPreference: k toValue: v].
        ((Array new: 3) at: 1 put: ((Array new: 3) at: 1 put: #inlineServicesInMenu;
                         at: 2 put: true;
                         at: 3 put: 'Inline services within squeak menus';
                         yourself);
                 at: 2 put: ((Array new: 3) at: 1 put: #useOnlyServicesInMenu;
                         at: 2 put: false;
                         at: 3 put: 'Use only services and not regular menu items';
                         yourself);
                 at: 3 put: ((Array new: 3) at: 1 put: #useServicesInBrowserButtonBar;
                         at: 2 put: true;
                         at: 3 put: 'Use a service-based button bar';
                         yourself);
                 yourself)
                do: [:tr | ServicePreferences
                                addPreference: tr first
                                categories: #('-- settings --' )
                                default: tr second
                                balloonHelp: tr third]!

----- Method: ServiceShortcuts class>>shortcut:event: (in category 'as yet unclassified') -----
shortcut: str event: event
        | s |
        Transcript cr.
        s := self map
                                at: str , event keyCharacter asString
                                ifAbsent: [^ self].
        (s beginsWith: '[') ifTrue: [^ (Compiler evaluateUnloggedForSelf:  s) value].
        s serviceOrNil
                ifNotNil: [:sv | sv execute.
        event wasHandled: true]!

----- Method: FillInTheBlankMorph>>selection (in category '*services-base') -----
selection
        "answers what is actually selected in the morph"
        ^ textPane selectionInterval!

----- Method: BlockClosure>>valueWithRequestor: (in category '*services-base') -----
valueWithRequestor: aRequestor
        "To do later: make the fillInTheBlank display more informative captions.
        Include the description of the service, and maybe record steps"

        ^ self numArgs isZero
                ifTrue: [self value]
                ifFalse: [self value: aRequestor]!

----- Method: SequenceableCollection>>startsWith: (in category '*services-base') -----
startsWith: start

        | comp |
        self deprecated: 'Use #beginsWith:'.
        self size < start size ifTrue: [^ false].
        comp := true.
        (self first: start size) with: start
                do: [:ea :ea2 | ea = ea2 ifFalse: [comp := false]].
        ^ comp!

----- Method: Morph>>requestor (in category '*services-base') -----
requestor
        ^ owner ifNil: [super requestor] ifNotNil: [owner requestor]!

Warning subclass: #ServiceCancelled
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'Services-Base'!

!ServiceCancelled commentStamp: 'rr 4/1/2004 18:24' prior: 0!
Exception raised when a service is cancelled, to inform the user.!

----- Method: ServiceCancelled>>defaultAction (in category 'handling') -----
defaultAction
        Transcript cr; show: 'service has been cancelled'!

----- Method: ServiceCancelled>>messageText (in category 'accessing') -----
messageText
        ^ 'Service has been cancelled'!

----- Method: CodeHolder>>messageListMenuServices: (in category '*services-base') -----
messageListMenuServices: aMenu
        <messageListMenu>
        <menuPriority: 150>

         ServiceGui browser: self messageListMenu: aMenu.
        ^ Preferences useOnlyServicesInMenu ifTrue: [nil] ifFalse: [aMenu]!

----- Method: CodeHolder>>requestor (in category '*services-base') -----
requestor
        ^ (BrowserRequestor new) browser: self; yourself!

----- Method: Browser>>browseReference: (in category '*services-base') -----
browseReference: ref
        self okToChange ifTrue: [
        self selectCategoryForClass: ref actualClass theNonMetaClass.
        self selectClass: ref actualClass theNonMetaClass .
        ref actualClass isMeta ifTrue: [self indicateClassMessages].
        self changed: #classSelectionChanged.
        self selectMessageCategoryNamed: ref category.
        self selectedMessageName: ref methodSymbol.
        ]!

----- Method: Browser>>classCategoryMenuServices: (in category '*services-base') -----
classCategoryMenuServices: aMenu
        <systemCategoryMenu>
        <menuPriority: 150>
        ServiceGui browser: self classCategoryMenu: aMenu.
        ^ Preferences useOnlyServicesInMenu ifTrue: [nil] ifFalse: [aMenu]!

----- Method: Browser>>classListMenuServices: (in category '*services-base') -----
classListMenuServices: aMenu
        <classListMenu>
        <menuPriority: 150>
        ServiceGui browser: self classMenu: aMenu.
        ^ Preferences useOnlyServicesInMenu ifTrue: [nil] ifFalse: [aMenu]!

----- Method: Browser>>messageCategoryMenuServices: (in category '*services-base') -----
messageCategoryMenuServices: aMenu
        <messageCategoryMenu>
        <menuPriority: 150>
        ServiceGui browser: self messageCategoryMenu: aMenu.
        ^ Preferences useOnlyServicesInMenu ifTrue: [nil] ifFalse: [aMenu]!

----- Method: Browser>>methodReference (in category '*services-base') -----
methodReference
        | cls sel |
        cls := self selectedClassOrMetaClass.
        sel := self selectedMessageName.
        cls isNil | sel isNil ifTrue: [^nil].
        ^ MethodReference class: cls selector: sel!

----- Method: Browser>>optionalButtonRow (in category '*services-base') -----
optionalButtonRow
        ^ServiceGui browserButtonRow: self inlinedIn: super optionalButtonRow!

----- Method: Browser>>selectReference: (in category '*services-base') -----
selectReference: ref
        self browseReference: ref!