[squeak-dev] Squeak 4.5: Services-Base-nice.50.mczcommits at source.squeak.org commits at source.squeak.orgFri Jan 24 20:11:42 UTC 2014
Chris Muller uploaded a new version of Services-Base to project Squeak 4.5: http://source.squeak.org/squeak45/Services-Base-nice.50.mcz ==================== Summary ==================== Name: Services-Base-nice.50 Author: nice Time: 18 December 2013, 2:59:13.287 pm UUID: 963e5ed8-8baa-425b-a73b-131d52bf202d Ancestors: Services-Base-nice.49 Classify some as yet unclassified. ==================== 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>>codeTextMorph (in category '*services-base') ----- codeTextMorph ^ self dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #contents]] ifNone: []! ----- 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 at 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 at 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: i | l sh str | l := self text. l size > 50 ifTrue: [l := (l first: 47) , '...']. sh := self shortcut. sh := (sh isNil or: [sh isEmpty]) ifTrue: [''] ifFalse: [' (' , sh , ')']. str := i isZero ifTrue: [''] ifFalse: [i asString, '. ']. ^ str, l capitalized , sh! ----- 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. 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>>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>>menuHook:named:shifted: (in category '*services-base') ----- menuHook: aMenu named: aSymbol shifted: aBool "Enhance aMenu with registered services." aSymbol caseOf: { [ #classListMenu ] -> [ ServiceGui browser: self classMenu: aMenu ]. [ #codePaneMenu ] -> [ ServiceGui browser: self codePaneMenu: aMenu ]. [ #messageCategoryMenu] -> [ ServiceGui browser: self messageCategoryMenu: aMenu ]. [ #messageListMenu ] -> [ ServiceGui browser: self messageListMenu: aMenu ]. [ #systemCategoryMenu ] -> [ ServiceGui browser: self classCategoryMenu: aMenu ] } otherwise: [ "do nothing" ]! ----- 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!
More information about the Squeak-dev mailing list |