'From Squeak3.3alpha of 18 January 2002 [latest update: #4962] on 22 August 2002 at 11:16:37 pm'! "Change Set: searchTweaks-sw Date: 22 August 2002 Author: Scott Wallace Published as 4963searchTweaks-sw.cs to 3.3a. Various tweaks and enhancements to the search-in-viewer facility, including... ¥ Makes the search-in-viewer work when the search button is pressed as well when enter or return is used to submit the search. ¥ When a user submits a search request in a Viewer and no hits are found, explicitly inform the user about this. ¥ Adds to the menu for every phrase in a viewer the item 'show categories...', which will present you with a list of all the viewer categories in which the item will be found; if you choose any of these, a viewer pane specifically for that catgory will replace the searching-viewer pane"! !DataType commentStamp: 'sw 8/22/2002 15:01' prior: 0! A Vocabulary representing typed data.! !Object methodsFor: 'viewer' stamp: 'sw 8/22/2002 14:07'! infoFor: anElement inViewer: aViewer "The user made a gesture asking for info/menu relating to me. Some of the messages dispatched here are not yet available in this image" | aMenu elementType | elementType _ self elementTypeFor: anElement vocabulary: aViewer currentVocabulary. ((elementType = #systemSlot) | (elementType == #userSlot)) ifTrue: [^ self slotInfoButtonHitFor: anElement inViewer: aViewer]. self flag: #deferred. "Use a traditional MenuMorph, and reinstate the pacify thing" aMenu _ MenuMorph new defaultTarget: aViewer. #( ('implementors' browseImplementorsOf:) ('senders' browseSendersOf:) ('versions' browseVersionsOf:) - ('browse full' browseMethodFull:) ('inheritance' browseMethodInheritance:) - ('about this method' aboutMethod:)) do: [:pair | pair = '-' ifTrue: [aMenu addLine] ifFalse: [aMenu add: pair first target: aViewer selector: pair second argument: anElement]]. aMenu addLine. aMenu defaultTarget: self. #( ('destroy script' removeScript:) ('rename script' renameScript:) ('pacify script' pacifyScript:)) do: [:pair | aMenu add: pair first target: self selector: pair second argument: anElement]. aMenu addLine. aMenu add: 'show categories....' target: aViewer selector: #showCategoriesFor: argument: anElement. aMenu items size == 0 ifTrue: "won't happen at the moment a/c the above" [aMenu add: 'ok' action: nil]. "in case it was a slot -- weird, transitional" aMenu addTitle: anElement asString, ' (', elementType, ')'. aMenu popUpInWorld: self currentWorld. ! ! !CategoryViewer methodsFor: 'initialization' stamp: 'sw 8/22/2002 23:08'! establishContents "Perform any initialization steps that needed to wait until I am installed in my outer viewer"! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 8/22/2002 14:00'! beReplacedByCategory: chosenCategory "Be replaced by a category pane pointed at the chosen category" self outerViewer replaceSubmorph: self by: (self outerViewer categoryViewerFor: chosenCategory) ! ! !CategoryViewer methodsFor: 'categories' stamp: 'sw 8/22/2002 14:01'! showCategoriesFor: aSymbol "Put up a pop-up list of categories in which aSymbol is filed; replace the receiver with a CategoryViewer for the one the user selects, if any" | allCategories aVocabulary hits meths chosen | aVocabulary _ self currentVocabulary. allCategories _ scriptedPlayer categoriesForVocabulary: aVocabulary limitClass: ProtoObject. hits _ allCategories select: [:aCategory | meths _ aVocabulary allMethodsInCategory: aCategory forInstance: scriptedPlayer ofClass: scriptedPlayer class. meths includes: aSymbol]. chosen _ (SelectionMenu selections: hits) startUp. chosen isEmptyOrNil ifFalse: [self beReplacedByCategory: chosen] ! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 8/22/2002 14:24'! phraseForCommandFrom: aMethodInterface "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp | aDocString _ aMethodInterface documentationOrNil. aDocString = 'no help available' ifTrue: [aDocString _ nil]. names _ scriptedPlayer class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ scriptedPlayer isUniversalTiles) ifTrue: [aPhrase _ scriptedPlayer universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player argType: argType. argTile _ ScriptingSystem tileForArgType: argType. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (scriptedPlayer slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd]) ifTrue: [aDocString ifNil: [aDocString _ (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentationOrNil]. aDocString ifNil: [balloonTextSelector _ #userScript]]. tileBearingHelp _ universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. aDocString ifNotNil: [tileBearingHelp setBalloonText: aDocString] ifNil: [balloonTextSelector ifNil: [tileBearingHelp setProperty: #inherentSelector toValue: cmd. balloonTextSelector _ #methodComment]. tileBearingHelp balloonTextSelector: balloonTextSelector]. aPhrase markAsPartsDonor. cmd == #emptyScript ifTrue: [aPhrase setProperty: #newPermanentScript toValue: true. aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer. aPhrase submorphs second setBalloonText: 'drag and drop to add a new script']. universal ifFalse: [selfTile _ self tileForSelf. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile]. aRow _ ViewerLine newRow borderWidth: 0; color: self color. aRow elementSymbol: cmd asSymbol. aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase). aRow addMorphBack: (Morph new extent: 2@2; beTransparent). aRow addMorphBack: (self infoButtonFor: cmd). aRow addMorphBack: aPhrase. (names includes: cmd) ifTrue: [aPhrase userScriptSelector: cmd. cmd numArgs == 0 ifTrue: [aPhrase beTransparent. aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer. aRow addMorphBack: (stat _ (inst _ scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph). inst updateStatusMorph: stat]]. aRow beSticky; disableDragNDrop. ^ aRow! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 8/22/2002 14:37'! phraseForVariableFrom: aMethodInterface "Return a structure consisting of tiles and controls and a readout representing a 'variable' belonging to the player, complete with an appropriate readout when indicated. Functions in both universalTiles mode and classic mode. Slightly misnamed in that this path is used for any methodInterface that indicates an interesting resultType." | anArrow slotName getterButton cover inner aRow doc setter tryer universal | aRow _ ViewerLine newRow color: self color; beSticky; elementSymbol: (slotName _ aMethodInterface selector); wrapCentering: #center; cellPositioning: #leftCenter. (universal _ scriptedPlayer isUniversalTiles) ifFalse: [aRow addMorphBack: (Morph new color: self color; extent: 11 @ 22; yourself)]. "spacer" aRow addMorphBack: (self infoButtonFor: slotName). aRow addMorphBack: (Morph new color: self color; extent: 0@10). " spacer" universal ifTrue: [inner _ scriptedPlayer universalTilesForGetterOf: aMethodInterface. cover _ Morph new color: Color transparent. cover extent: inner fullBounds extent. (getterButton _ cover copy) addMorph: cover; addMorphBack: inner. cover on: #mouseDown send: #makeUniversalTilesGetter:event:from: to: self withValue: aMethodInterface. aRow addMorphFront: (tryer _ ScriptingSystem tryButtonFor: inner). tryer color: tryer color lighter lighter] ifFalse: [aRow addMorphBack: self tileForSelf bePossessive. aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" getterButton _ self getterButtonFor: aMethodInterface selector type: aMethodInterface resultType]. aRow addMorphBack: getterButton. (doc _ aMethodInterface documentationOrNil) ifNotNil: [getterButton setBalloonText: doc]. universal ifFalse: [(slotName == #seesColor:) ifTrue: [self addIsOverColorDetailTo: aRow. ^ aRow]. (slotName == #touchesA:) ifTrue: [self addTouchesADetailTo: aRow. ^ aRow]]. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" (setter _ aMethodInterface companionSetterSelector) ifNotNil: [aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" anArrow _ universal ifTrue: [self arrowSetterButton: #newMakeSetterFromInterface:evt:from: args: aMethodInterface] ifFalse: [self arrowSetterButton: #makeSetter:from:forPart: args: (Array with: slotName with: aMethodInterface resultType)]. aRow addMorphBack: anArrow]. (#(color:sees: playerSeeingColor copy touchesA:) includes: slotName) ifFalse: [(universal and: [slotName == #seesColor:]) ifFalse: [aRow addMorphBack: (self readoutFor: slotName type: aMethodInterface resultType readOnly: setter isNil getSelector: aMethodInterface selector putSelector: setter)]]. anArrow ifNotNil: [anArrow step]. ^ aRow! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 8/22/2002 15:00'! wantsRowMenuFor: aSymbol "Answer whether a viewer row for the given symbol should have a menu button on it" | elementType | true ifTrue: [^ true]. "To allow show categories item. So someday this method can be removed, and its sender can stop sending it..." elementType _ scriptedPlayer elementTypeFor: aSymbol vocabulary: self currentVocabulary. (elementType == #systemScript) ifTrue: [^ false]. ((elementType == #systemSlot) and: [#(color:sees: touchesA:) includes: aSymbol]) ifTrue: [^ false]. ^ true! ! !DataType methodsFor: 'tiles' stamp: 'sw 8/22/2002 14:59'! addWatcherItemsToMenu: aMenu forGetter: aGetter "Add watcher items to the menu if appropriate, provided the getter is not an odd-ball one for which a watcher makes no sense" (#(colorSees copy newClone getNewClone color:sees: touchesA:) includes: aGetter) ifFalse: [aMenu add: 'simple watcher' selector: #tearOffWatcherFor: argument: aGetter]! ! !Player methodsFor: 'slots-kernel' stamp: 'sw 8/22/2002 15:03'! typeForSlotWithGetter: aGetter "Answer the data type for values of the instance variable of the given name" | getter inherentSelector | (#(color:sees: touchesA:) includes: aGetter) ifTrue: [^ #Boolean]. "Annoying special cases" inherentSelector _ Utilities inherentSelectorForGetter: aGetter. (self slotInfo includesKey: inherentSelector) ifTrue: [^ (self slotInfoAt: inherentSelector) type]. getter _ (aGetter beginsWith: 'get') ifTrue: [aGetter] ifFalse: [Utilities getterSelectorFor: aGetter]. ^ (Vocabulary eToyVocabulary methodInterfaceAt: getter ifAbsent: [self error: 'Unknown slot name: ', aGetter]) resultType! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 8/22/2002 13:53'! infoFor: anElement inViewer: aViewer "The user made a gesture asking for info/menu relating" | aMenu elementType aSelector | elementType _ self elementTypeFor: anElement vocabulary: aViewer currentVocabulary. ((elementType = #systemSlot) | (elementType == #userSlot)) ifTrue: [^ self slotInfoButtonHitFor: anElement inViewer: aViewer]. aMenu _ MenuMorph new defaultTarget: self. aMenu defaultTarget: self. aSelector _ anElement asSymbol. (elementType == #userScript) ifTrue: [aMenu add: 'destroy "', anElement, '"' selector: #removeScriptWithSelector: argument: aSelector. aMenu add: 'rename "', anElement, '"' selector: #renameScript: argument: aSelector. aMenu add: 'textual scripting pane' selector: #makeIsolatedCodePaneForSelector: argument: aSelector. aSelector numArgs > 0 ifTrue: [aMenu add: 'remove parameter' selector: #ceaseHavingAParameterFor: argument: aSelector] ifFalse: [aMenu add: 'add parameter' selector: #startHavingParameterFor: argument: aSelector. aMenu add: 'button to fire this script' selector: #tearOffButtonToFireScriptForSelector: argument: aSelector]. aMenu add: 'edit balloon help' selector: #editDescriptionForSelector: argument: aSelector]. aMenu add: 'show categories....' target: aViewer selector: #showCategoriesFor: argument: aSelector. aMenu items size == 0 ifTrue: "Never 0 at the moment because of show categories addition" [aMenu add: 'ok' action: nil]. aMenu addTitle: anElement asString, ' (', elementType, ')'. aMenu popUpInWorld: aViewer world! ! !Player methodsFor: 'scripts-kernel' stamp: 'sw 8/22/2002 13:49'! slotInfoButtonHitFor: aGetterSymbol inViewer: aViewer "The user made a gesture asking for slot menu for the given getter symbol in a viewer; put up the menu." | aMenu slotSym aType typeVocab | slotSym _ Utilities inherentSelectorForGetter: aGetterSymbol. aType _ self typeForSlotWithGetter: aGetterSymbol asSymbol. aMenu _ MenuMorph new defaultTarget: self. aMenu addTitle: (slotSym asString, ' (', aType, ')'). (typeVocab _ Vocabulary vocabularyForType: aType) addWatcherItemsToMenu: aMenu forGetter: aGetterSymbol. (self slotInfo includesKey: slotSym) ifTrue: [aMenu add: 'change data type' selector: #chooseSlotTypeFor: argument: aGetterSymbol. typeVocab addUserSlotItemsTo: aMenu slotSymbol: slotSym. "e.g. decimal places" aMenu add: 'remove "', slotSym, '"' selector: #removeSlotNamed: argument: slotSym. aMenu add: 'rename "', slotSym, '"' selector: #renameSlot: argument: slotSym]. typeVocab addExtraItemsToMenu: aMenu forSlotSymbol: slotSym. "e.g. Player type adds hand-me-tiles" aMenu add: 'show categories....' target: aViewer selector: #showCategoriesFor: argument: aGetterSymbol. self addIdiosyncraticMenuItemsTo: aMenu forSlotSymol: slotSym. aMenu items size == 0 ifTrue: [aMenu add: 'ok' action: #yourself]. aMenu popUpForHand: aViewer primaryHand in: aViewer world! ! !SearchingViewer methodsFor: 'initialization' stamp: 'sw 8/22/2002 23:12'! establishContents "Perform any initialization steps that needed to wait until I am installed in my outer viewer" searchString isEmptyOrNil ifFalse: [self doSearchFrom: searchString]! ! !SearchingViewer methodsFor: 'initialization' stamp: 'sw 8/22/2002 23:09'! setCategorySymbolFrom: aChoice "Set my category symbol" self chosenCategorySymbol: #search. self rawSearchString: aChoice second! ! !SearchingViewer methodsFor: 'search' stamp: 'sw 8/22/2002 13:39'! doSearchFrom: aSource "Perform the search operation" | searchFor aVocab aList all anInterface useTranslations scriptNames addedMorphs | searchString _ (aSource isKindOf: PluggableTextMorph) ifFalse: [aSource] ifTrue: [aSource text string]. searchFor _ searchString asString asLowercase withBlanksTrimmed. aVocab _ self outerViewer currentVocabulary. ((scriptedPlayer isKindOf: Player) and: [aVocab isKindOf: EToyVocabulary]) ifTrue: [all _ scriptedPlayer costume selectorsForViewer. all addAll: (scriptNames _ scriptedPlayer class namedTileScriptSelectors). useTranslations _ true] ifFalse: [all _ scriptNames _ scriptedPlayer class allSelectorsUnderstood. useTranslations _ false]. aList _ all select: [:aSelector | (aVocab includesSelector: aSelector forInstance: scriptedPlayer ofClass: scriptedPlayer class limitClass: ProtoObject) and: [(useTranslations and: [(anInterface _ aVocab methodInterfaceAt: aSelector ifAbsent: [nil]) notNil and: [anInterface elementWording includesSubstring: searchFor caseSensitive: false]]) or: [((scriptNames includes: aSelector) or: [useTranslations not]) and: [aSelector includesSubstring: searchFor caseSensitive: false]]]]. aList _ aList asSortedArray. self removeAllButFirstSubmorph. "that being the header" self addAllMorphs: ((addedMorphs _ scriptedPlayer tilePhrasesForSelectorList: aList inViewer: self)). self enforceTileColorPolicy. self secreteCategorySymbol. self world ifNotNil: [self world startSteppingSubmorphsOf: self]. self adjustColorsAndBordersWithin. owner ifNotNil: [owner isStandardViewer ifTrue: [owner fitFlap]. addedMorphs size = 0 ifTrue: [self inform: 'No matches found for "', searchFor, '"']]! ! !SearchingViewer methodsFor: 'search' stamp: 'sw 8/22/2002 15:14'! rawSearchString: aString "Set the search string as indicated" searchString _ aString asString! ! !SearchingViewer methodsFor: 'search' stamp: 'sw 8/22/2002 20:30'! searchString: aString notifying: znak "Set the search string as indicated and carry out a search" searchString _ aString asString. self doSearchFrom: searchString! ! !StandardViewer methodsFor: 'categories' stamp: 'sw 8/22/2002 23:04'! addCategoryViewerFor: categoryInfo "Add a category viewer for the given category info" | aViewer | aViewer _ self categoryViewerFor: categoryInfo. self addMorphBack: aViewer. aViewer establishContents. self world ifNotNil: [self world startSteppingSubmorphsOf: aViewer]. self fitFlap! ! !StandardViewer methodsFor: 'categories' stamp: 'sw 8/22/2002 13:58'! categoryViewerFor: categoryInfo "Answer a category viewer for the given category info" | aViewer | aViewer _ ((categoryInfo isKindOf: Collection) and: [categoryInfo first == #search]) ifFalse: [CategoryViewer new] ifTrue: [SearchingViewer new]. aViewer initializeFor: scriptedPlayer categoryChoice: categoryInfo. ^ aViewer! !