'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5313] on 3 July 2003 at 7:14:06 pm'! "Change Set: TextStyleCleanup36-nk Date: 3 July 2003 Author: Ned Konz v3: made Utilities methods deprecated instead of removed. Added comments to TextStyle class methods. v2: checked against latest 3.6a work. Moved font-related methods out of Utilities and into TextStyle. If you're using Connectors, you should also load ConnectorsTextCleanup-nk. "! !AbstractFont methodsFor: 'accessing' stamp: 'nk 5/26/2003 09:45'! isRegular ^false! ! !ParagraphEditor methodsFor: 'menu messages' stamp: 'nk 7/3/2003 18:27'! changeStyle "Let user change styles for the current text pane Moved from experimentalCommand to its own method " | aList reply style | aList _ StrikeFont actualFamilyNames. aList addFirst: 'DefaultTextStyle'. reply _ (SelectionMenu labelList: aList lines: #(1) selections: aList) startUp. reply ifNotNil: [(style _ TextStyle named: reply) ifNil: [self beep. ^ true]. paragraph textStyle: style copy. paragraph composeAll. self recomputeSelection. self mvcRedisplay]. ^ true! ! !Preferences class methodsFor: 'fonts' stamp: 'nk 6/17/2003 14:28'! chooseFontWithPrompt: aPrompt andSendTo: aReceiver withSelector: aSelector Smalltalk isMorphic ifFalse: [TextStyle mvcPromptForFont: aPrompt andSendTo: aReceiver withSelector: aSelector] ifTrue: [TextStyle promptForFont: aPrompt andSendTo: aReceiver withSelector: aSelector]! ! !ScreenController methodsFor: 'menu messages' stamp: 'nk 6/17/2003 14:39'! fontSizeSummary TextStyle fontSizeSummary! ! !StrikeFont methodsFor: 'accessing' stamp: 'nk 6/17/2003 14:26'! textStyle ^ TextStyle actualTextStyles detect: [:aStyle | aStyle fontArray includes: self] ifNone: [nil]! ! !StrikeFont class methodsFor: 'instance creation' stamp: 'nk 7/3/2003 17:10'! fromUser: priorFont "StrikeFont fromUser" "Present a menu of available fonts, and if one is chosen, return it. Otherwise return nil." | fontList fontMenu style active ptMenu label spec font | fontList _ StrikeFont actualFamilyNames. fontMenu _ MenuMorph new defaultTarget: self. fontList do: [:fontName | style _ TextStyle named: fontName. active _ priorFont familyName sameAs: fontName. ptMenu _ MenuMorph new defaultTarget: self. style pointSizes do: [:pt | (active and:[pt = priorFont pointSize]) ifTrue:[label _ ''] ifFalse:[label _ '']. label _ label, pt printString, ' pt'. ptMenu add: label target: fontMenu selector: #modalSelection: argument: {fontName. pt}]. style isTTCStyle ifTrue: [ ptMenu add: 'new size' target: style selector: #addNewFontSizeDialog: argument: {fontName. fontMenu}. ]. active ifTrue:[label _ ''] ifFalse:[label _ '']. label _ label, fontName. fontMenu add: label subMenu: ptMenu]. spec _ fontMenu invokeModal: false. "don't allow keyboard control" spec ifNil: [^ nil]. style _ TextStyle named: spec first. style ifNil: [^ self]. font _ style fonts detect: [:any | any pointSize = spec last] ifNone: [nil]. ^ font! ! !StrikeFont class methodsFor: 'accessing' stamp: 'nk 6/17/2003 15:15'! actualFamilyNames "Answer a sorted list of actual family names, without the Default aliases" ^(self familyNames copyWithoutAll: #(DefaultTextStyle DefaultFixedTextStyle)) asOrderedCollection! ! !TTCFont methodsFor: 'accessing' stamp: 'nk 6/17/2003 14:26'! textStyle ^ TextStyle actualTextStyles detect: [:aStyle | aStyle fontArray includes: self] ifNone: [nil]! ! !TextMorph methodsFor: 'accessing' stamp: 'nk 7/3/2003 18:33'! textAlignment "Answer 1..4, representing #leftFlush, #rightFlush, #centered, or #justified" ^self editor textAlignment! ! !TextMorph methodsFor: 'accessing' stamp: 'nk 6/18/2003 14:28'! textAlignmentSymbol "Answer one of #leftFlush, #rightFlush, #centered, or #justified" ^self editor textAlignmentSymbol! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'nk 7/3/2003 18:33'! changeEmphasisOrAlignment | aList reply code align menuList | self flag: #arNote. "Move this up once we get rid of MVC" aList := #(#plain #bold #italic #narrow #underlined #struckOut #leftFlush #centered #rightFlush #justified). align := self textAlignment. code := paragraph text emphasisAt: startBlock stringIndex. menuList := WriteStream on: Array new. menuList nextPut: (code = 0 ifTrue: ['plain'] ifFalse: ['plain']). menuList nextPutAll: (#(#bold #italic #underlined #struckOut) collect: [:emph | (code anyMask: (TextEmphasis perform: emph) emphasisCode) ifTrue: ['' , emph] ifFalse: ['' , emph]]). ((paragraph text attributesAt: startBlock stringIndex forStyle: paragraph textStyle) anySatisfy: [:attr | attr isKern and: [attr kern < 0]]) ifTrue: [menuList nextPut: 'narrow'] ifFalse: [menuList nextPut: 'narrow']. menuList nextPutAll: (#(#leftFlush #rightFlush #centered #justified) collectWithIndex: [:type :i | align = i ifTrue: ['' , type] ifFalse: ['' , type]]). aList := #(#plain #bold #italic #underlined #struckOut #narrow #leftFlush #rightFlush #centered #justified). reply := (SelectionMenu labelList: menuList contents lines: #(1 6) selections: aList) startUpWithoutKeyboard. reply ifNotNil: [(#(#leftFlush #centered #rightFlush #justified) includes: reply) ifTrue: [self setAlignment: reply. paragraph composeAll. self recomputeInterval] ifFalse: [self setEmphasis: reply. paragraph composeAll. self recomputeSelection. self mvcRedisplay]]. ^true! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'nk 7/3/2003 17:13'! changeStyle "Let user change styles for the current text pane." | aList reply style theStyle menuList | self flag: #arNote. "Move this up once we get rid of MVC" aList _ StrikeFont actualFamilyNames. theStyle _ paragraph textStyle. menuList _ aList collect:[:styleName| "Hack!! use defaultFont for comparison - we have no name that we could use for compare and the style changes with alignment so they're no longer equal." (TextConstants at: styleName) defaultFont == theStyle defaultFont ifTrue:['', styleName] ifFalse:['',styleName]]. theStyle = TextStyle default ifTrue:[menuList addFirst: 'DefaultTextStyle'] ifFalse:[menuList addFirst: 'DefaultTextStyle']. aList addFirst: 'DefaultTextStyle'. reply _ (SelectionMenu labelList: menuList lines: #(1) selections: aList) startUp. reply ifNotNil: [(style _ TextStyle named: reply) ifNil: [self beep. ^ true]. paragraph textStyle: style copy. paragraph composeAll. self recomputeSelection. self mvcRedisplay]. ^ true! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'nk 7/3/2003 18:33'! textAlignment "Answer 1..4, representing #leftFlush, #rightFlush, #centered, or #justified" ^paragraph text alignmentAt: startBlock stringIndex ifAbsent: [paragraph textStyle alignment]! ! !TextMorphEditor methodsFor: 'attributes' stamp: 'nk 7/3/2003 18:33'! textAlignmentSymbol ^#(leftFlush rightFlush centered justified) at: self textAlignment ! ! !TextPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'nk 6/17/2003 15:16'! changeStyle | aList reply style | aList _ StrikeFont actualFamilyNames. aList addFirst: 'DefaultTextStyle'. reply _ (SelectionMenu labelList: aList lines: #(1) selections: aList) startUp. reply ifNil: [^self]. (style _ TextStyle named: reply) ifNil: [self beep. ^ true]. self applyToWholeText ifTrue: [self activeEditor selectAll]. self activeEditor changeStyleTo: style copy. self activeTextMorph updateFromParagraph.! ! !TextStyle class methodsFor: 'constants' stamp: 'nk 7/3/2003 19:11'! named: familyName "Answer the TextStyle with the given name, or nil." "TextStyle named: 'NewYork'" | textStyle | textStyle _ TextConstants at: familyName ifAbsent: [ ^nil ]. (textStyle isKindOf: self) ifFalse: [ ^nil ]. ^textStyle! ! !TextStyle class methodsFor: 'user interface' stamp: 'nk 7/3/2003 18:53'! chooseTTCFontSize: args "Prompt for a point size and, if one is given, add a new font size to the font named by the first member of args. If args' length is three, send a message with the selector equal to the third of args, and the receiver equal to the second of args, passing the selected style as an argument." | f n style | f _ FillInTheBlank request: 'New Point Size' initialAnswer: '0'. n _ f asNumber. style _ (TextConstants at: args first) addNewFontSize: n. style ifNotNil: [ args second ifNotNil: [args second perform: args third with: style]. ]. ! ! !TextStyle class methodsFor: 'user interface' stamp: 'nk 7/3/2003 19:08'! fontMenuForStyle: styleName target: target selector: selector "Offer a font menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font." | aMenu | aMenu _ MenuMorph entitled: styleName. TextConstants at: styleName ifPresent: [:s | (s isTTCStyle) ifTrue: [ aMenu add: 'New Size' target: self selector: #chooseTTCFontSize: argument: {styleName. target. selector}. ]. ]. (self pointSizesFor: styleName) do: [:aWidth | | font | font _ (self named: styleName) fontOfPointSize: aWidth. aMenu add: (aWidth asString, ' Point') target: target selector: selector argument: font. aMenu lastItem font: font ]. ^ aMenu! ! !TextStyle class methodsFor: 'user interface' stamp: 'nk 7/3/2003 19:09'! fontSizeSummary "Open a text window with a simple summary of the available sizes in each of the fonts in the system." "TextStyle fontSizeSummary" | aString aList | aList _ self knownTextStyles. aString _ String streamContents: [:aStream | aList do: [:aStyleName | aStream nextPutAll: aStyleName, ' ', (self fontPointSizesFor: aStyleName) asArray storeString. aStream cr]]. (StringHolder new contents: aString) openLabel: 'Font styles and sizes'! ! !TextStyle class methodsFor: 'user interface' stamp: 'nk 7/3/2003 19:01'! mvcPromptForFont: aPrompt andSendTo: aTarget withSelector: aSelector "MVC Only!! prompt for a font and if one is provided, send it to aTarget using a message with selector aSelector." | aMenu aChoice aStyle namesAndSizes aFont | "TextStyle mvcPromptForFont: 'Choose system font style' andSendTo: TextStyle withSelector: #setSystemFontTo:" aMenu _ CustomMenu new. self actualTextStyles keys do: [:styleName | aMenu add: styleName action: styleName]. aChoice _ aMenu startUpWithCaption: aPrompt. aChoice ifNil: [^ self]. aMenu _ CustomMenu new. aStyle _ self named: aChoice. (namesAndSizes _ aStyle fontNamesWithPointSizes) do: [:aString | aMenu add: aString action: aString]. aChoice _ aMenu startUpWithCaption: nil. aChoice ifNil: [^ self]. aFont _ aStyle fontAt: (namesAndSizes indexOf: aChoice). aTarget perform: aSelector with: aFont! ! !TextStyle class methodsFor: 'user interface' stamp: 'nk 7/3/2003 19:02'! promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector "Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a message with selector aSelector." "TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector: #setSystemFontTo:" "Derived from a method written by Robin Gibson" | menu subMenu | menu _ MenuMorph entitled: aPrompt. self actualTextStyles keys do: [:styleName| subMenu _ self fontMenuForStyle: styleName target: aTarget selector: aSelector. menu add: styleName subMenu: subMenu. menu lastItem font: ((self named: styleName) fontOfSize: 18)]. menu popUpInWorld: self currentWorld! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 19:12'! actualTextStyles | aDict | "TextStyle actualTextStyles" "Answer dictionary whose keys are the names of styles in the system and whose values are the actual styles" aDict _ TextConstants select: [:thang | thang isKindOf: self ]. aDict removeKey: #DefaultTextStyle. aDict removeKey: #DefaultFixedTextStyle. ^ aDict! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 19:06'! fontArrayForStyle: aName "Answer the fonts in the style named aName, or an empty Array if no such named style." "TextStyle fontArrayForStyle: #Atlanta" "TextStyle fontPointSizesFor: 'NewYork'" ^ ((self named: aName) ifNil: [ ^#() ]) fontArray ! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 18:56'! fontPointSizesFor: aName "Answer the point sizes for all the fonts in the given text style" "TextStyle fontPointSizesFor: 'Arial'" "TextStyle fontPointSizesFor: 'NewYork'" ^ (self fontArrayForStyle: aName) collect: [:f | f pointSize] ! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 18:58'! fontSizesFor: aName "Answer the pixel sizes for all the fonts in the given text style" "TextStyle fontSizesFor: 'Arial'" "TextStyle fontSizesFor: 'NewYork'" ^ (self fontArrayForStyle: aName) collect: [:f | f height ] ! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 18:58'! fontWidthsFor: aName "Answer the widths for all the fonts in the given text style" "TextStyle fontWidthsFor: 'ComicPlain'" ^ (self fontArrayForStyle: aName) collect: [:f | f maxWidth] ! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 19:00'! knownTextStyles "Answer the names of the known text styles, sorted in alphabetical order" "TextStyle knownTextStyles" ^ (TextConstants select: [:thang | thang isKindOf: TextStyle]) keys asSortedArray ! ! !TextStyle class methodsFor: 'TextConstants access' stamp: 'nk 7/3/2003 19:11'! pointSizesFor: aName "Answer all the point sizes for the given text style name" "TextStyle pointSizesFor: 'NewYork'" ^ (self fontArrayForStyle: aName) collect: [:f | f pointSize] ! ! !TheWorldMenu methodsFor: 'construction' stamp: 'nk 7/3/2003 17:14'! helpMenu "Build the help menu for the world." | screenCtrl genieEnabledString | screenCtrl _ ScreenController new. genieEnabledString _ World currentHand isGenieEnabled ifTrue: ['disable'] ifFalse: ['enable']. ^ self fillIn: (self menu: 'help...') from: { {'about this system...'. {Smalltalk. #aboutThisSystem}. 'current version information.'}. {'update code from server'. {Utilities. #updateFromServer}. 'load latest code updates via the internet'}. {'preferences...'. {Preferences. #openPreferencesInspector}. 'view and change various options.'}. {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} . nil. {genieEnabledString , ' genie'. {World currentHand. #switchGenieEnabled}. genieEnabledString , ' gesture recognizer for the world''s current hand'}. {'genie gesture dictionaries'. {CRDictionary. #openInstanceBrowserMorph}. 'edit or inspect gesture dictionaries'.}. {'choose genie text dictionary'. {CRDictionary. #chooseTextDictionary}. 'select the dictionary used for text input'.}. {'genie display properties'. {CRDisplayProperties. #openInstanceBrowserMorph}. 'edit or inspect display properies'.}. nil. {'command-key help'. { Utilities . #openCommandKeyHelp}. 'summary of keyboard shortcuts.'}. {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}. "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}." {'font size summary' . { TextStyle . #fontSizeSummary}. 'summary of names and sizes of available fonts.'}. {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}. {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}. nil. {'graphical imports' . { Imports default . #viewImages}. 'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}. {'standard graphics library' . { ScriptingSystem . #inspectFormDictionary}. 'lets you view and change the system''s standard library of graphics.'}. nil. {'telemorphic...' . {self. #remoteDo}. 'commands for doing multi-machine "telemorphic" experiments'}. {#soundEnablingString . { Preferences . #toggleSoundEnabling}. 'turning sound off will completely disable Squeak''s use of sound.'}. {'definition for...' . { Utilities . #lookUpDefinition}. 'if connected to the internet, use this to look up the definition of an English word.'}. nil. {'set author initials...' . { screenCtrl . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}. {'vm statistics' . { screenCtrl . #vmStatistics}. 'obtain some intriguing data about the vm.'}. nil. {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}. {'space left' . { screenCtrl . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}. } ! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:50'! actualTextStyles "Answer dictionary whose keys are the names of styles in the system and whose values are the actual styles" "TextStyle actualTextStyles" self deprecatedExplanation: 'Use TextStyle actualTextStyles instead.'. ^TextStyle actualTextStyles! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:50'! chooseTTCFontSize: args "Adds the new-size selection to the font size menu." self deprecatedExplanation: 'Use TextStyle chooseTTCFontSize: instead.'. ^TextStyle chooseTTCFontSize: args! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:50'! fontArrayForStyle: aName "TextStyle fontArrayForStyle: 'Arial'" "TextStyle fontPointSizesFor: 'NewYork'" self deprecatedExplanation: 'Use TextStyle fontArrayForStyle: instead.'. ^TextStyle fontArrayForStyle: aName! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:50'! fontMenuForStyle: styleName target: target selector: selector self deprecatedExplanation: 'Use TextStyle fontMenuForStyle: target: selector: instead.'. ^TextStyle fontMenuForStyle: styleName target: target selector: selector! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:42'! fontPointSizesFor: aName "TextStyle fontPointSizesFor: 'Arial'" "TextStyle fontPointSizesFor: 'NewYork'" self deprecatedExplanation: 'Use TextStyle fontPointSizesFor: instead.'. ^TextStyle fontPointSizesFor: aName! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:43'! fontSizeSummary "TextStyle fontSizeSummary" self deprecatedExplanation: 'Use TextStyle fontSizeSummary instead.'. TextStyle fontSizeSummary! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:49'! fontSizesFor: aName "TextStyle fontSizesFor: 'Arial'" self deprecatedExplanation: 'Use TextStyle fontSizesFor: instead.'. ^TextStyle fontSizesFor: aName! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:49'! fontWidthsFor: aName "TextStyle fontWidthsFor: 'Arial'" self deprecatedExplanation: 'Use TextStyle fontWidthsFor: instead.'. ^TextStyle fontWidthsFor: aName! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:49'! knownTextStyles "TextStyle knownTextStyles" self deprecatedExplanation: 'Use TextStyle knownTextStyles instead.'. ^TextStyle knownTextStyles! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:49'! mvcPromptForFont: aPrompt andSendTo: aTarget withSelector: aSelector "TextStyle mvcPromptForFont: 'Choose system font style' andSendTo: TextStyle withSelector: #setSystemFontTo:" self deprecatedExplanation: 'Use TextStyle mvcPromptForFont: andSendTo: withSelector: instead.'. ^TextStyle mvcPromptForFont: aPrompt andSendTo: aTarget withSelector: aSelector! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:49'! pointSizesFor: aName "TextStyle pointSizesFor: 'New York'" self deprecatedExplanation: 'Use TextStyle pointSizesFor: instead.'. ^TextStyle pointSizesFor: aName! ! !Utilities class methodsFor: 'deprecated' stamp: 'nk 7/3/2003 18:48'! promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector "TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector: #setSystemFontTo:" "NOTE: Morphic ONLY!!!!" self deprecatedExplanation: 'Use TextStyle promptForFont: andSendTo: withSelector: instead.'. ^TextStyle promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector! ! !Utilities class reorganize! ('class initialization' initialize registerInFlapsRegistry unload) ('common requests' appendToCommonRequests: closeAllDebuggers commonRequestStrings: editCommonRequestStrings eval: evaluate:in:to: initializeCommonRequestStrings offerCommonRequests offerCommonRequestsInMorphic) ('debugging' doesNotUnderstand: inspectCollection:notifying:) ('durable menus' windowFromMenu:target:title: windowFromMenu:target:title:colorPattern: windowMenuWithLabels:colorPattern:targets:selections:title: windowMenuWithLabels:colorPattern:targets:selections:wordingSelectors:title:) ('fetching updates' applyUpdatesFromDisk applyUpdatesFromDiskToUpdateNumber:stopIfGap: broadcastUpdatesFrom:to:except: chooseUpdateList extractThisVersion: fileInFromUpdatesFolder: getUpdateDirectoryOrNil lastUpdateNum: newUpdatesOn:special:throughNumber: objectStrmFromUpdates: parseListContents: position:atVersion: readNextUpdateFromServer readNextUpdatesFromDisk: readServer:special:updatesThrough:saveLocally:updateImage: readServerUpdatesSaveLocally:updateImage: readServerUpdatesThrough:saveLocally:updateImage: retrieveUrls:ontoQueue:withWaitSema: saveUpdate:onFile: serverUrls setUpdateServer: summariesForUpdates:through: updateComment updateFromServer updateFromServerThroughUpdateNumber: updateUrlLists writeList:toStream: zapUpdateDownloader) ('deprecated' actualTextStyles chooseTTCFontSize: fontArrayForStyle: fontMenuForStyle:target:selector: fontPointSizesFor: fontSizeSummary fontSizesFor: fontWidthsFor: knownTextStyles mvcPromptForFont:andSendTo:withSelector: pointSizesFor: promptForFont:andSendTo:withSelector:) ('fileout' fileOutChangeSetsNamed: fileOutChanges) ('flaps' globalFlapTabOrDummy:) ('graphical support' grabScreenAndSaveOnDisk showFormsAcrossTopOfScreen: showFormsDictAcrossTopOfScreen:) ('identification' authorInitials authorInitialsPerSe authorName authorName: authorNamePerSe browseUncommentedMethodsWithInitials: changeStamp changeStampPerSe copyrightNotice dateStamp dateTimeSuffix fixStamp: methodsWithInitials: monthDayTime24StringFrom: monthDayTimeStringFrom: setAuthorInitials setAuthorInitials: setAuthorName) ('investigations' inspectGlobals reportSenderCountsFor:) ('miscellaneous' addSampleWindowsTo: awaitMouseUpIn:repeating:ifSucceed: awaitMouseUpIn:whileMouseDownDo:whileMouseDownInsideDo:ifSucceed: cleanseOtherworldlySteppers convertCRtoLF: createPageTestWorkspace decimalPlacesForFloatPrecision: decommissionTheAllCategory doesMethod:forClass:bearInitials: emergencyCollapse fixUpProblemsWithAllCategory floatPrecisionForDecimalPlaces: getterSelectorFor: inherentSelectorForGetter: instanceComparisonsBetween:and: isObject:memberOfOneOf: keyLike:satisfying: keyLike:withTrailing:satisfying: lookUpDefinition methodDiffFor:class:selector:prettyDiffs: nextClockwiseSideAfter: openScratchWorkspaceLabeled:contents: oppositeCornerFrom: oppositeModeTo: oppositeSideTo: reconstructTextWindowsFromFileNamed: setClassAndSelectorFrom:in: setterSelectorFor: simpleSetterFor: steplistToolsWorkspace storeTextWindowContentsToFileNamed: timeStampForMethod:) ('recent method submissions' assureMostRecentSubmissionExists browseRecentSubmissions dumpAnyOldStyleRecentSubmissions mostRecentlySubmittedMessage noteMethodSubmission:forClass: numberOfRecentSubmissionsToStore numberOfRecentSubmissionsToStore: openRecentSubmissionsBrowser purgeFromRecentSubmissions: purgeRecentSubmissionsOfMissingMethods recentMethodSubmissions recentSubmissionsWindow revertLastMethodSubmission) ('scraps' addToTrash: emptyScrapsBook maybeEmptyTrash scrapsBook trashTitle) ('summer97 additions' browseVersionsForClass:selector: chooseFileWithSuffix: chooseFileWithSuffixFromList:withCaption: classCategoriesStartingWith: classFromPattern:withCaption: graphicsFileSuffixes hierarchyOfClassesSurrounding: hierarchyOfImplementorsOf:forClass: inviolateInstanceVariableNames isLegalInstVarName: methodHierarchyBrowserForClass:selector: spawnHierarchyForClass:selector: wellFormedInstanceVariableNameFrom:) ('support windows' commandKeyMappings openCommandKeyHelp openStandardWorkspace standardWorkspaceContents) ('system navigation' systemNavigation) ('tailoring system' stripMethods:messageCode:) ('user interface' informUser:during: informUserDuring: obtainArrowheadFor:defaultValue: pointOrNilFrom:) ('vm statistics' vmStatisticsReportString vmStatisticsShortString) !