SystemOrganization addCategory: #'PetitGui-Core'! SystemOrganization addCategory: #'PetitGui-Refactoring'! SystemOrganization addCategory: #'PetitGui-Tests'! !PPChoiceParser methodsFor: '*petitgui-morphic' stamp: 'lr 5/2/2010 20:15'! exampleOn: aStream "If there is already a lot written, try to pick an empty possiblity." aStream position > 512 ifTrue: [ (parsers anySatisfy: [ :each | each isNullable ]) ifTrue: [ ^ self ] ]. parsers atRandom exampleOn: aStream! ! !PPChoiceParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 11:14'! morphicShapeSeen: aSet depth: anInteger ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | | morph | morph := self newColumnMorph cellInset: 5; yourself. self children do: [ :each | morph addMorphBack: (self newRowMorph hResizing: #spaceFill; addMorphBack: (cc value: each); addMorphBack: (self newColumnMorph hResizing: #spaceFill; addMorphBack: (self newSpacerMorph height: 10); addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) hResizing: #spaceFill; minWidth: 20; yourself); yourself); yourself) ]. morph fullBounds. self newRowMorph addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph height: 10); addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); yourself); addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph width: 1; height: 10); addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1); yourself); addMorphBack: morph; addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph width: 1; height: 10); addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1) makeForwardArrow; width: 1; yourself); yourself ]! ! !PPPredicateParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/2/2010 19:35'! displayName ^ predicateMessage! ! !PPPredicateParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/1/2010 17:05'! exampleOn: aStream "Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others." | valid normal | valid := Character allCharacters select: [ :char | self matches: (String with: char) ]. normal := valid select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ]. aStream nextPut: (normal isEmpty ifTrue: [ valid atRandom ] ifFalse: [ normal atRandom ])! ! RBRemoveClassRefactoring subclass: #PPRemoveParserRefactoring instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPRemoveParserRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/18/2011 15:20'! onClass: aClass ^ self new setClass: aClass; yourself! ! !PPRemoveParserRefactoring methodsFor: 'preconditions' stamp: 'lr 12/18/2011 15:21'! preconditions ^ (self checkCompositeParser: class) & (RBCondition hasSubclasses: class) not! ! !PPRemoveParserRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 15:21'! setClass: aClass class := self classObjectFor: aClass! ! !PPRemoveParserRefactoring methodsFor: 'transforming' stamp: 'lr 12/18/2011 15:22'! transform model removeClass: class! ! !PPLiteralSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPutAll: literal! ! !PPUnresolvedParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:15'! displayColor ^ Color red! ! !PPEndOfInputParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:18'! displayDescription ^ 'end of input'! ! !PPLiteralObjectParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPut: literal! ! RBExtractMethodRefactoring subclass: #PPExtractProdcutionRefactoring instanceVariableNames: 'targetProduction' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPExtractProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/10/2011 11:03'! onClass: aClass production: aSelector interval: anInterval to: aTargetSelector ^ (self extract: anInterval from: aSelector in: aClass) setTargetProduction: aTargetSelector; yourself! ! !PPExtractProdcutionRefactoring methodsFor: 'transforming' stamp: 'lr 12/10/2011 11:11'! existingSelector ^ nil! ! !PPExtractProdcutionRefactoring methodsFor: 'transforming' stamp: 'lr 12/10/2011 11:10'! getNewMethodName parameters isEmpty ifFalse: [ self refactoringError: 'Cannot extract production since it contains references.' ]. targetProduction asSymbol isUnary ifFalse: [ self refactoringError: 'Invalid production name.' ]. ^ targetProduction asSymbol! ! !PPExtractProdcutionRefactoring methodsFor: 'transforming' stamp: 'lr 12/10/2011 11:15'! nameNewMethod: aSymbol class addInstanceVariable: aSymbol asString. extractedParseTree renameSelector: aSymbol andArguments: #(). modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: aSymbol asString in: modifiedParseTree! ! !PPExtractProdcutionRefactoring methodsFor: 'preconditions' stamp: 'lr 12/18/2011 14:49'! preconditions ^ (self checkCompositeParser: class) & super preconditions & (RBCondition definesSelector: targetProduction asSymbol in: class) not & (RBCondition definesInstanceVariable: targetProduction asString in: class) not! ! !PPExtractProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/10/2011 11:02'! setTargetProduction: aSymbol targetProduction := aSymbol! ! !PPExtractProdcutionRefactoring methodsFor: 'requests' stamp: 'lr 12/10/2011 11:12'! shouldExtractAssignmentTo: aString ^ false! ! !PPTrimmingParser methodsFor: '*petitgui-accessing' stamp: 'lr 4/14/2010 20:48'! exampleOn: aStream super exampleOn: aStream. aStream nextPut: Character space! ! !PPNotParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:17'! displayDescription ^ 'not'! ! !PPNotParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/11/2009 21:09'! exampleOn: aStream! ! !PPSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:24'! exampleOn: aStream parsers do: [ :each | each exampleOn: aStream ]! ! !PPSequenceParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/17/2009 21:54'! morphicShapeSeen: aSet depth: anInteger ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | self children inject: self newRowMorph into: [ :result :each | result addMorphBack: (cc value: each); yourself ] ]! ! !PPPluggableParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:41'! displayName ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]! ! !PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:17'! displayDescription ^ 'and'! ! !PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 5/1/2010 16:16'! exampleOn: aStream! ! GLMCompositePresentation subclass: #PPAllParsersBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPAllParsersBrowser commentStamp: 'TudorGirba 3/4/2011 18:55' prior: 0! self open! !PPAllParsersBrowser class methodsFor: 'as yet unclassified' stamp: 'TudorGirba 11/25/2012 20:36'! open ^ self new openOn: PPCompositeParser! ! !PPAllParsersBrowser methodsFor: 'private building' stamp: 'TudorGirba 11/30/2012 09:09'! addNewSubParserOf: class in: list | refactoring className | className := UIManager default request: 'Parser class name' initialAnswer: '' title: 'Add new parser'. ^ className ifNotNil: [ refactoring := PPAddParserRefactoring name: className asSymbol category: #ParserExample superclass: class. PPRefactoringUtils new performRefactoring: refactoring. list update ]! ! !PPAllParsersBrowser methodsFor: 'private building' stamp: 'TudorGirba 11/30/2012 09:12'! classesIn: composite composite tree title: 'Parsers'; format: [ :class | class name ]; children: [ :class | class subclasses asSortedCollection: [ :a :b | a name < b name ] ]; display: [ :class | class subclasses asSortedCollection: [ :a :b | a name < b name ] ]; selectionAct: [ :list :class | Smalltalk tools browser fullOnClass: list selection ] on: $b entitled: 'Browse (b)'; selectionAct: [ :list :class | self addNewSubParserOf: list selection in: list ] entitled: 'Add new sub parser'; act: [ :list :class | self addNewSubParserOf: class in: list ] icon: GLMUIThemeExtraIcons glamorousAdd on: $+ entitled: 'Add new parser'! ! !PPAllParsersBrowser methodsFor: 'building' stamp: 'TudorGirba 11/25/2012 20:40'! compose "self open" self title: 'PetitParser Browser'. self tabulator with: [ :tabulator | tabulator column: #classes; column: #parser span: 3. tabulator transmit to: #classes; andShow: [:a | self classesIn: a ]. tabulator transmit to: #parser; from: #classes; andShow: [:a | a custom: PPParserBrowser new noTitle ] ]! ! GLMCompositePresentation subclass: #PPParserBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPParserBrowser commentStamp: 'TudorGirba 11/25/2012 20:38' prior: 0! self new openOn: PPArithmeticParser! !PPParserBrowser class methodsFor: 'as yet unclassified' stamp: 'TudorGirba 11/26/2012 21:09'! openOn: aParserClass ^ self new openOn: aParserClass! ! !PPParserBrowser methodsFor: 'building' stamp: 'JanKurs 11/30/2012 14:53'! buildBrowser "self openOn: PPArithmeticParser" | browser | browser := GLMTabulator new. browser title: [:each | each name]. browser row: [:r | r column: #productions ; column: #workspace span: 2]; row: #inspector. browser transmit to: #productions; andShow: [:a | self productionsIn: a ]. browser transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a | self workspaceIn: a ]. browser transmit to: #inspector; fromOutsidePort: #entity; from: #productions; passivelyFrom: #outer port: #sampleText; andShow: [:a | self inspectorIn: a ]. browser transmit from: #inspector port: #sampleText; toOutsidePort: #sampleText; when: [:arg | arg notNil ]. browser transmit from: #workspace; toOutsidePort: #productionToSelect; transformed: [:parser | parser name ]; when: [:parser | parser name notNil ]. browser transmit fromOutsidePort: #productionToSelect; to: #productions port: #selection. ^ browser! ! !PPParserBrowser methodsFor: 'building' stamp: 'TudorGirba 11/26/2012 21:10'! compose "self openOn: PPArithmeticParser" self title: [:each | each name]. self tabulator with: [ :tabulator | tabulator row: [:r | r column: #productions ; column: #workspace span: 2]; row: #inspector. tabulator transmit to: #productions; andShow: [:a | self productionsIn: a ]. tabulator transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a | self workspaceIn: a ]. tabulator transmit to: #inspector; fromOutsidePort: #entity; from: #productions; passivelyFrom: #outer port: #sampleText; andShow: [:a | self inspectorIn: a ]. tabulator transmit from: #inspector port: #sampleText; toOutsidePort: #sampleText; when: [:arg | arg notNil ]. tabulator transmit from: #workspace; toOutsidePort: #productionToSelect; transformed: [:parser | parser name ]; when: [:parser | parser name notNil ]. tabulator transmit fromOutsidePort: #productionToSelect; to: #productions port: #selection ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/15/2011 12:53'! exampleIn: composite composite text title: 'Example'; useExplicitNotNil; display: [ :class :productionSelector | (self production: productionSelector from: class) example ]; act: [:text | text update] icon: GLMUIThemeExtraIcons glamorousRefresh entitled: 'Generate another one'! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/20/2011 16:26'! firstIn: composite composite list title: 'First'; useExplicitNotNil; display: [ :class :productionSelector | (self production: productionSelector from: class) firstSet ]; format: [ :parser | parser displayName ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/20/2011 16:28'! followIn: aBrowser aBrowser list title: 'Follow'; useExplicitNotNil; format: [ :parser | parser displayName ]; display: [ :class :productionSelector | | parser | parser := class new. parser followSets at: (parser productionAt: productionSelector) ifAbsent: [ Array with: nil asParser ] ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/4/2011 00:50'! graphIn: composite composite morph title: 'Graph'; useExplicitNotNil; display: [ :class :selector | | morph | morph := ScrollPane new. morph color: Color white. morph scroller addMorph: (self production: selector from: class) morphicProduction. morph ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 11/26/2012 20:59'! inspectorIn: composite composite dynamic allowNil; display: [ :class :productionSelector :sampleText | | wrapperBrowser | wrapperBrowser := GLMTabulator new. wrapperBrowser allowNil. wrapperBrowser column: #wrapped. wrapperBrowser transmit to: #wrapped; andShow: [ :a | a custom: (PPParserInspector new noTitle) ]. wrapperBrowser transmit from: #wrapped port: #sampleText; toOutsidePort: #sampleText. wrapperBrowser transmit fromOutsidePort: #sampleText; to: #wrapped port: #sampleText. wrapperBrowser startOn: ([(self production: productionSelector from: class) end] on: Error do: [:e | nil]) . (wrapperBrowser pane port: #sampleText) value: (sampleText ifNil: [ '' ] ifNotNil: [ sampleText ]). wrapperBrowser ] ! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 10/12/2012 16:20'! mapIn: composite self class environment at: #GLMRoassalPresentation ifPresent: [ :cls | composite roassal title: 'Map'; useExplicitNotNil; painting: [ :view :class :selector | (self production: #start from: class) viewAllNamedParsersWithSelection: (Array with: selector) previewing: [:eachParser | self sourceCodeFrom: class selector: eachParser name ] on: view ] ] ! ! !PPParserBrowser methodsFor: 'private utilities' stamp: 'TudorGirba 12/3/2011 23:50'! production: selector from: class | parser | parser := class new. ^ selector isNil ifTrue: [ parser ] ifFalse: [ parser productionAt: selector ]! ! !PPParserBrowser methodsFor: 'private utilities' stamp: 'TudorGirba 12/8/2011 14:25'! productionSelectorsFrom: class ^ (((class allInstVarNames copyWithoutAll: class ignoredNames) collect: [ :each | each asSymbol ]) select: [ :each | class includesSelector: each ]) asSortedCollection! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 11/28/2012 22:58'! productionsIn: composite "Doru: These menus should be built dynamically: title and enabled status should adapt" "enabled: RBRefactoryChangeManager instance hasRedoableOperations" " , RBRefactoryChangeManager instance redoChange" "enabled: RBRefactoryChangeManager instance hasUndoableOperations" " , RBRefactoryChangeManager instance undoChange " composite list title: [ :class | class name ]; format: [ :class | class asString ]; display: [ :class | self productionSelectorsFrom: class ]; shouldValidate: true; act: [ :list :class | RBRefactoryChangeManager instance redoOperation. list pane browser update ] icon: GLMUIThemeExtraIcons glamorousRedo entitled: 'Redo'; act: [ :list :class | RBRefactoryChangeManager instance undoOperation. list pane browser update ] icon: GLMUIThemeExtraIcons glamorousUndo entitled: 'Undo'; selectionAct: [ :list :class | | oldName refactoring | oldName := list selection. refactoring := PPRefactoringUtils new performRenameProduction: oldName from: class. refactoring changes changes notEmpty ifTrue: [ list update. list selection: refactoring changes changes first newName asSymbol ] ] on: $r entitled: 'Rename (r)'; selectionAct: [ :list :class | PPRefactoringUtils new performRefactoring: (PPRemoveProdcutionRefactoring onClass: class production: list selection). list pane browser update ] on: $x entitled: 'Remove (x)'; selectionAct: [ :list :class | Smalltalk tools browser fullOnClass: class selector: list selection ] on: $b entitled: 'Browse (b)'; selectionAct: [ :list :class | (self production: list selection from: class) explore ] on: $I entitled: 'Explore (I)'! ! !PPParserBrowser methodsFor: 'private utilities' stamp: 'TudorGirba 12/6/2011 07:45'! sourceCodeFrom: class selector: production ^ class sourceCodeAt: (production ifNil: [ #start ]) ifAbsent: [ String new ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 11/28/2012 22:59'! sourceIn: composite composite smalltalkCode title: 'Source'; useExplicitNotNil; display: [ :class :production | self sourceCodeFrom: class selector: production ]; smalltalkClass: [ :class | class ]; selectionAct: [ :text :class :production | | selector refactoring | selector := UIManager default request: 'Production name to extract to:' initialAnswer: '' title: 'Extract production'. selector isEmptyOrNil ifFalse: [ selector := selector asSymbol. refactoring := PPExtractProdcutionRefactoring onClass: class production: production interval: text selectionInterval to: selector. PPRefactoringUtils new performRefactoring: refactoring. text pane browser update. (text pane port: #productionToSelect) value: selector ] ] on: $e entitled: 'Extract production'; act: [ :text :class :production | | selector refactoring | refactoring := PPDefineProdcutionRefactoring onClass: class source: text text asString protocols: #(grammar). PPRefactoringUtils new performRefactoring: refactoring. selector := refactoring changes changes last selector. selector = production ifTrue: [text update] ifFalse: [ text pane browser update. (text pane port: #productionToSelect) value: selector ] ] icon: GLMUIThemeExtraIcons glamorousAccept on: $s entitled: 'Accept'! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/20/2011 16:24'! workspaceIn: composite self sourceIn: composite. self graphIn: composite. self mapIn: composite. self exampleIn: composite. self firstIn: composite. self followIn: composite.! ! GLMCompositePresentation subclass: #PPParserInspector instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPParserInspector commentStamp: 'TudorGirba 12/3/2011 17:25' prior: 0! This browser expects an instance of PPParser in the #entity port. self openOn: PPArithmeticParser new.! !PPParserInspector class methodsFor: 'as yet unclassified' stamp: 'JanKurs 11/30/2012 15:00'! openOn: aParserInstance ^ self new openOn: aParserInstance! ! !PPParserInspector methodsFor: 'building' stamp: 'TudorGirba 11/26/2012 21:12'! compose "self new openOn: PPArithmeticParser new" self title: [:each | 'Parser Inspector on ', (each name ifNil: [each class name])]. self tabulator with: [ :browser | browser column: #sample; column: #inspectors. (browser transmit) fromOutsidePort: #entity; fromOutsidePort: #sampleText; to: #sample; andShowIfNone: [ :a | self sampleIn: a ]. (browser transmit) from: #sample port: #text; toOutsidePort: #sampleText. (browser transmit) from: #sample; "result" passivelyFrom: #sample port: #text; "sample text" from: #sample port: #stream; "parser stream" fromOutsidePort: #entity; "parser" to: #inspectors; andShow: [ :a | self inspectorsIn: a ]. browser transmit from: #inspectors; to: #sample port: #selectionInterval; transformed: [:debugResult | debugResult ifNotNil: [debugResult start to: debugResult end] ] ]! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/3/2011 21:59'! debuggerIn: composite composite tree title: 'Debugger'; format: [:resultNode | resultNode formattedText ]; display: [ :result :sample :stream :parser | {PPParserDebuggerResult parse: sample with: parser } ]; children: [:resultNode | resultNode children ].! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/3/2011 21:50'! inspectorsIn: composite self resultIn: composite. self debuggerIn: composite. self tallyIn: composite. self profileIn: composite. self progressIn: composite! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/14/2011 17:48'! profileIn: composite composite table title: 'Profile'; column: 'Parser' evaluated: [ :each | each first displayName ]; column: 'Time (ms)' evaluated: [ :each | each second printString ]; column: 'Percentage (%)' evaluated: [ :each | each third printString ]; display: [ :result :sample :stream :parser | stream asFrequencyTable ]; noSelection; showOnly: 50 ! ! !PPParserInspector methodsFor: 'private building' stamp: 'lr 9/12/2011 18:41'! progressChartIn: composite composite morph title: 'Progress'; display: [ :stream | | morph | morph := ScrollPane new. morph color: Color white. morph scroller addMorph: stream asPositionMorph. morph ]! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/3/2011 21:59'! progressIn: composite composite morph title: 'Progress'; display: [:result :sample :stream :parser | | morph | morph := ScrollPane new. morph color: Color white. morph scroller addMorph: stream asPositionMorph. morph ]! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/15/2011 14:46'! resultIn: composite (composite text) title: 'Result'; display: [ :result :sample :stream :parser | result ]; act: [ :text :result :sample :stream :parser | result inspect ] icon: GLMUIThemeExtraIcons glamorousInspect entitled: 'Inspect'! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 11/30/2012 23:51'! sampleIn: composite (composite text) title: 'Sample'; display: [:parser :sample | sample ifNil: [''] ]; allowNil; populate: #selection icon: GLMUIThemeExtraIcons glamorousPlay on: $s entitled: 'Parse (s)' with: [ :presentation :parser | | stream output | stream := PPBrowserStream on: presentation text asString. output := parser parse: stream. output isPetitFailure ifTrue: [ presentation selectionInterval: (output position + 1 to: output position) ]. (presentation pane port: #stream) value: stream. output ]! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/14/2011 17:48'! tallyIn: composite composite table title: 'Tally'; column: 'Parser' evaluated: [ :each | each first displayName ]; column: 'Count' evaluated: [ :each | each second printString ]; column: 'Percentage (%)' evaluated: [ :each | each third printString ]; display: [:result :sample :stream :parser | stream asFrequencyTable ]; noSelection; showOnly: 50! ! !PPRepeatingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:18'! displayDescription ^ String streamContents: [ :stream | min = 0 ifFalse: [ stream print: min; nextPutAll: '..' ]. max = SmallInteger maxVal ifTrue: [ stream nextPut: $* ] ifFalse: [ stream print: max ] ]! ! !PPRepeatingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/11/2009 20:57'! exampleOn: aStream "Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet." min timesRepeat: [ super exampleOn: aStream ]. (max - min min: 5) atRandom timesRepeat: [ aStream position > 512 ifTrue: [ ^ self ]. super exampleOn: aStream ]! ! PPStream subclass: #PPBrowserStream instanceVariableNames: 'positions stamps parsers' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPBrowserStream methodsFor: 'converting' stamp: 'lr 4/15/2010 15:12'! asExecutionTrace | trace | trace := OrderedCollection new: parsers size. 1 to: parsers size do: [ :index | | parser | parser := parsers at: index. parser name isNil ifFalse: [ | start stop | start := positions at: index. stop := positions at: index + 1 ifAbsent: [ self size ]. trace addLast: (Array with: parser with: start with: stop) ] ]. ^ trace! ! !PPBrowserStream methodsFor: 'converting' stamp: 'lr 2/3/2010 20:21'! asFrequencyTable | bag total result | bag := parsers asBag. total := 100.0 / bag size. result := OrderedCollection new. bag sortedCounts do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ]. ^ result! ! !PPBrowserStream methodsFor: 'converting' stamp: 'lr 6/3/2010 10:29'! asPositionDrawing | stream source last | stream := WriteStream on: String new. source := self contents readStream. last := 0. [ source atEnd ] whileFalse: [ [ source atEnd not and: [ source peek isSeparator ] ] whileTrue: [ source next ]. stream nextPutAll: '\fill [source] ('; print: source position / 100.0; nextPutAll: ', 0) rectangle ('. [ source atEnd not and: [ source peek isSeparator not ] ] whileTrue: [ source next ]. stream print: source position / 100.0; nextPutAll: ', '; print: self positions size / 100.0; nextPutAll: ');'; cr ]. stream nextPutAll: '\draw [parser] (0, 0)'. 1 to: self positions size do: [ :index | last <= (self positions at: index) ifTrue: [ stream nextPutAll: ' --' ]. last := self positions at: index. stream nextPutAll: ' ('; print: last / 100.0; nextPutAll: ', '; print: index / 100.0; nextPut: $) ]. stream nextPut: $;. ^ stream contents! ! !PPBrowserStream methodsFor: 'converting' stamp: 'lr 6/4/2010 14:53'! asPositionMorph | width height canvas morph | width := self size + 1 min: 2048. height := self positions size min: 2048. canvas := FormCanvas extent: width @ height. self contents keysAndValuesDo: [ :index :char | char isSeparator ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleBlue ] ]. 1 to: height do: [ :index | canvas form colorAt: (self positions at: index) @ index put: Color black ]. morph := canvas form asMorph. morph on: #mouseDown send: #mouseDown:with: to: self. ^ morph! ! !PPBrowserStream methodsFor: 'converting' stamp: 'lr 2/3/2010 20:21'! asTimingTable | bag total result | bag := Bag new. 1 to: stamps size - 1 do: [ :index | bag add: (parsers at: index) withOccurrences: (stamps at: index + 1) - (stamps at: index) ]. total := stamps last - stamps first. result := OrderedCollection new. bag sortedCounts do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ]. ^ result! ! !PPBrowserStream methodsFor: 'private' stamp: 'TudorGirba 12/3/2011 21:52'! mouseDown: anEvent with: aMorph | location string parser | location := anEvent position. string := collection copyFrom: (location x - 5 min: collection size max: 1) asInteger to: (location x + 5 min: collection size max: 1) asInteger. parser := parsers at: location y. Transcript show: string printString; cr; show: parser displayName; cr; cr! ! !PPBrowserStream methodsFor: 'accessing' stamp: 'lr 2/3/2010 13:45'! next | result | result := super next. self step. ^ result! ! !PPBrowserStream methodsFor: 'accessing' stamp: 'lr 2/3/2010 13:45'! next: aNumber | result | result := super next: aNumber. self step. ^ result! ! !PPBrowserStream methodsFor: 'information' stamp: 'lr 2/3/2010 14:55'! parsers ^ parsers! ! !PPBrowserStream methodsFor: 'positioning' stamp: 'lr 2/3/2010 13:46'! position: aNumber super position: aNumber. self step! ! !PPBrowserStream methodsFor: 'information' stamp: 'lr 2/3/2010 14:55'! positions ^ positions! ! !PPBrowserStream methodsFor: 'positioning' stamp: 'lr 2/3/2010 14:53'! reset super reset. positions := OrderedCollection new: 1024. stamps := OrderedCollection new: 1024. parsers := OrderedCollection new: 1024! ! !PPBrowserStream methodsFor: 'information' stamp: 'lr 2/3/2010 14:55'! stamps ^ stamps! ! !PPBrowserStream methodsFor: 'private' stamp: 'TudorGirba 3/8/2011 12:08'! step positions addLast: position. stamps addLast: Time millisecondClockValue. parsers addLast: thisContext sender sender receiver! ! !PPFailingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:16'! displayColor ^ Color red! ! !PPFailingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:43'! displayName ^ message! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:11'! backgroundForDepth: anInteger ^ Color gray: 1.0 - (anInteger / 20.0)! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 9/12/2011 18:34'! displayColor ^ self isTerminal ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ] ifFalse: [ Color blue ]! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:31'! displayName ^ self name isNil ifFalse: [ self name asString ] ifTrue: [ self class name asString ]! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:37'! example ^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:20'! exampleOn: aStream! ! !PPParser methodsFor: '*petitgui' stamp: 'TudorGirba 11/25/2012 20:41'! gtInspectorParserInspectorIn: composite composite custom: ( PPParserInspector new title: 'Inspector'; startOn: self)! ! !PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 10:56'! morphicProduction ^ self newRowMorph layoutInset: 4; addMorphBack: (self newRowMorph layoutInset: 4; addMorphBack: (StringMorph new contents: self displayName; emphasis: TextEmphasis bold emphasisCode; yourself); yourself); addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0); addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph); addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) makeForwardArrow; yourself); yourself! ! !PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/17/2009 22:03'! morphicShapeDefault ^ self newRowMorph addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph); addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) makeForwardArrow; yourself); addMorphBack: (self newRowMorph borderWidth: 1; layoutInset: 3; color: Color white; on: #click send: #value to: [ Transcript show: self; cr ]; addMorphBack: (StringMorph new contents: self displayName; color: self displayColor; yourself); yourself); yourself! ! !PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/13/2009 13:24'! morphicShapeSeen: aSet depth: anInteger ^ self morphicShapeDefault! ! !PPParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/13/2009 13:43'! morphicShapeSeen: aSet depth: anInteger do: aBlock " avoid recursion " (aSet includes: self) ifTrue: [ ^ self morphicShapeDefault ]. " display nice name when possible " (anInteger > 0 and: [ self name notNil ]) ifTrue: [ ^ self morphicShapeDefault ]. " don't do it too deep " (anInteger > 10) ifTrue: [ ^ self morphicShapeDefault ]. aSet add: self. ^ aBlock value: [ :parser | parser morphicShapeSeen: aSet depth: anInteger + 1 ]! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'tg 8/25/2010 00:31'! namedParsers | result | result := OrderedCollection new. self namedParsersDo: [ :parser | result addLast: parser ]. ^ result! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'tg 8/25/2010 00:32'! namedParsersDo: aBlock self namedParsersDo: aBlock seen: IdentitySet new! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'TudorGirba 12/14/2011 12:40'! namedParsersDo: aBlock seen: aSet self children do: [ :each | (aSet includes: each) ifFalse: [ aSet add: each. each name isEmptyOrNil ifFalse: [ aBlock value: each ] ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]! ! !PPParser methodsFor: '*petitgui-morphic-creational' stamp: 'lr 11/17/2009 21:58'! newColumnMorph ^ AlignmentMorph newColumn cellPositioning: #topLeft; color: Color transparent; listCentering: #topLeft; vResizing: #shrinkWrap; hResizing: #shrinkWrap; layoutInset: 0; yourself! ! !PPParser methodsFor: '*petitgui-morphic-creational' stamp: 'lr 11/17/2009 21:57'! newRowMorph ^ AlignmentMorph newRow cellPositioning: #topLeft; color: Color transparent; listCentering: #topLeft; vResizing: #shrinkWrap; hResizing: #shrinkWrap; layoutInset: 0; yourself! ! !PPParser methodsFor: '*petitgui-morphic-creational' stamp: 'lr 11/17/2009 22:03'! newSpacerMorph ^ Morph new color: Color transparent; borderWidth: 0; extent: 7 @ 7; yourself! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'tg 8/25/2010 00:34'! viewAllNamedParsers | view | view := MOViewRenderer new. self viewAllNamedParsersOn: view. view open! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'tg 8/25/2010 00:34'! viewAllNamedParsersOn: view view shape rectangle text: #displayName; withoutBorder. view nodes: (self allParsers select: [:each | each name isEmptyOrNil not ]). view edgesToAll: #namedParsers. view horizontalDominanceTreeLayout layered! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'TudorGirba 12/6/2011 07:43'! viewAllNamedParsersWithSelection: aCollectionOfNames on: view self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view! ! !PPParser methodsFor: '*petitgui-mondrian' stamp: 'TudorGirba 10/18/2012 09:38'! viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view view shape label color: [:each | (aCollectionOfNames includes: each name) ifFalse: [Color black] ifTrue: [Color red]]; text: [:each |each displayName]. view interaction popupText: aBlock. view interaction item: 'Explore' action: #explore. view nodes: (self allParsers select: [:each | each name isEmptyOrNil not ]). view edges: (self allParsers select: [:each | each name isEmptyOrNil not ])from: #yourself toAll: #namedParsers. view horizontalDominanceTreeLayout verticalGap: 10; layered! ! TestCase subclass: #PPGrammarRefactoringTest instanceVariableNames: 'refactoring' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Tests'! !PPGrammarRefactoringTest methodsFor: 'accessing' stamp: 'lr 12/7/2011 22:14'! change ^ self refactoring changes! ! !PPGrammarRefactoringTest methodsFor: 'accessing' stamp: 'lr 12/7/2011 22:14'! changes ^ self change changes! ! !PPGrammarRefactoringTest methodsFor: 'utilities' stamp: 'lr 12/7/2011 22:08'! performRefactoring: aRefactoring refactoring := aRefactoring. aRefactoring primitiveExecute! ! !PPGrammarRefactoringTest methodsFor: 'accessing' stamp: 'lr 12/7/2011 22:09'! refactoring ^ refactoring! ! !PPGrammarRefactoringTest methodsFor: 'testing-parsers' stamp: 'lr 12/18/2011 15:13'! testAddParser self performRefactoring: (PPAddParserRefactoring name: #PPMockParser category: #'PetitGui-Mock'). self assert: self changes size = 2. self assert: self changes first class = RBAddClassChange. self assert: self changes first definitionClass = PPCompositeParser. self assert: self changes first changeClassName = #PPMockParser. self assert: self changes first category = #'PetitGui-Mock'. self assert: self changes last class = RBAddMethodChange. self assert: self changes last parseTree = (RBParser parseMethod: 'start ^ self shouldBeImplemented')! ! !PPGrammarRefactoringTest methodsFor: 'testing-parsers' stamp: 'lr 12/18/2011 15:14'! testAddParserWithSuperclass self performRefactoring: (PPAddParserRefactoring name: #PPMockParser category: #'PetitGui-Mock' superclass: PPArithmeticParser). self assert: self changes size = 2. self assert: self changes first class = RBAddClassChange. self assert: self changes first definitionClass = PPArithmeticParser. self assert: self changes first changeClassName = #PPMockParser. self assert: self changes first category = #'PetitGui-Mock'. self assert: self changes last class = RBAddMethodChange. self assert: self changes last parseTree = (RBParser parseMethod: 'start ^ self shouldBeImplemented')! ! !PPGrammarRefactoringTest methodsFor: 'testing-productions' stamp: 'lr 12/10/2011 11:22'! testDefineProduction self performRefactoring: (PPDefineProdcutionRefactoring onClass: PPArithmeticParser source: 'function ^ #any plus , $( , $) ==> [ :e | 0 ]' protocols: (Array with: #productions)). self assert: self changes size = 2. self assert: self changes first class = RBAddInstanceVariableChange. self assert: self changes first variable = 'function'. self assert: self changes last class = RBAddMethodChange. self assert: self changes last parseTree = (RBParser parseMethod: 'function ^ #any asParser plus , $( asParser , $) asParser ==> [ :e | 0 ]')! ! !PPGrammarRefactoringTest methodsFor: 'testing-productions' stamp: 'lr 12/10/2011 11:21'! testExtractProduction self performRefactoring: (PPExtractProdcutionRefactoring onClass: PPArithmeticParser production: #addition interval: (36 to: 60) to: #plusOrMinus). self assert: self changes size = 3. self assert: self changes first class = RBAddInstanceVariableChange. self assert: self changes first variable = 'plusOrMinus'. self assert: self changes second class = RBAddMethodChange. self assert: self changes second parseTree = (RBParser parseMethod: 'plusOrMinus ^ $+ asParser / $- asParser'). self assert: self changes last class = RBAddMethodChange. self assert: self changes last parseTree = (RBParser parseMethod: 'addition ^ (factors separatedBy: plusOrMinus token trim) foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]')! ! !PPGrammarRefactoringTest methodsFor: 'testing-parsers' stamp: 'lr 12/18/2011 15:23'! testRemoveParser self performRefactoring: (PPRemoveParserRefactoring onClass: PPArithmeticParser). self assert: self changes size = 1. self assert: self changes first class = RBRemoveClassChange. self assert: self changes first changeClassName = 'PPArithmeticParser'! ! !PPGrammarRefactoringTest methodsFor: 'testing-productions' stamp: 'lr 12/7/2011 22:17'! testRemoveProduction self performRefactoring: (PPRemoveProdcutionRefactoring onClass: PPArithmeticParser production: #addition). self assert: self changes size = 2. self assert: self changes first class = RBRemoveMethodChange. self assert: self changes first selector = #addition. self assert: self changes last class = RBRemoveInstanceVariableChange. self assert: self changes last variable = 'addition'! ! !PPGrammarRefactoringTest methodsFor: 'testing-productions' stamp: 'lr 12/10/2011 11:23'! testRenameProduction self performRefactoring: (PPRenameProdcutionRefactoring onClass: PPArithmeticParser rename: #addition to: #add). self assert: self changes size = 3. self assert: self changes first class = RBRenameInstanceVariableChange. self assert: self changes first oldName = 'addition'. self assert: self changes first newName = 'add'. self assert: self changes second class = RBAddMethodChange. self assert: self changes second parseTree = (RBParser parseMethod: 'add ^ (factors separatedBy: ($+ asParser / $- asParser) token trim) foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]'). self assert: self changes last class = RBRemoveMethodChange. self assert: self changes last selector = #addition! ! TestCase subclass: #PPParserDebuggerResultTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Tests'! !PPParserDebuggerResultTest methodsFor: 'tests' stamp: 'TudorGirba 12/3/2011 19:22'! testArithmetic | parser result | parser := PPArithmeticParser new. result := PPParserDebuggerResult parse: '1 + 2' with: parser. self assert: result children size = 1. self assert: result children first result = 3! ! !PPParserDebuggerResultTest methodsFor: 'tests' stamp: 'TudorGirba 12/3/2011 19:34'! testNumberParser | parser result | parser := PPArithmeticParser new productionAt: #number. result := PPParserDebuggerResult parse: '1' with: parser. self assert: result children isEmpty. self assert: result result = 1! ! !PPEpsilonParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:42'! displayName ^ 'epsilon'! ! !PPEpsilonParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 11:15'! morphicShapeSeen: aSet depth: anInteger ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | self newRowMorph addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph height: 10); addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); yourself); yourself ]! ! !PPDelegateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:20'! displayDescription ^ nil! ! !PPDelegateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:27'! exampleOn: aStream parser exampleOn: aStream! ! !PPDelegateParser methodsFor: '*petitgui-morphic' stamp: 'lr 11/18/2009 11:21'! morphicShapeSeen: aSet depth: anInteger ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc | self displayDescription isNil ifTrue: [ cc value: parser ] ifFalse: [ self newRowMorph addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph height: 10); addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); yourself); addMorphBack: (self newRowMorph color: (self backgroundForDepth: anInteger); addMorphBack: (self newColumnMorph addMorphBack: (cc value: parser); addMorphBack: (self newRowMorph hResizing: #spaceFill; addMorphBack: (self newSpacerMorph width: 20; yourself); addMorphBack: (self newColumnMorph hResizing: #spaceFill; listCentering: #center; addMorphBack: (self newSpacerMorph); addMorphBack: (StringMorph new contents: self displayDescription; yourself); yourself); yourself); yourself); addMorphBack: (self newColumnMorph addMorphBack: (self newSpacerMorph height: 10); addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1); yourself); yourself); yourself ] ]! ! !PPLiteralParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:19'! displayName ^ literal printString! ! RBRefactoring subclass: #PPAddParserRefactoring instanceVariableNames: 'superclass name cateogry' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPAddParserRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/18/2011 15:06'! name: aString category: aSymbol ^ self name: aString category: aSymbol superclass: PPCompositeParser! ! !PPAddParserRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/18/2011 15:06'! name: aString category: aSymbol superclass: aClass ^ self new setName: aString; setCategory: aSymbol; setSuperclass: aClass; yourself! ! !PPAddParserRefactoring methodsFor: 'preconditions' stamp: 'lr 12/18/2011 15:01'! preconditions ^ self checkCompositeParser: superclass! ! !PPAddParserRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 15:14'! setCategory: aSymbol cateogry := aSymbol asSymbol! ! !PPAddParserRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 14:59'! setName: aString name := aString! ! !PPAddParserRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 14:59'! setSuperclass: aClass superclass := self classObjectFor: aClass! ! !PPAddParserRefactoring methodsFor: 'accessing' stamp: 'lr 12/18/2011 15:11'! startProductionSource ^ 'start ^ self shouldBeImplemented'! ! !PPAddParserRefactoring methodsFor: 'transforming' stamp: 'lr 12/18/2011 15:08'! transform self performComponentRefactoring: (RBAddClassRefactoring model: self model addClass: name superclass: superclass subclasses: #() category: cateogry). (self classObjectFor: name) compile: self startProductionSource classified: #(accessing)! ! RBRefactoring subclass: #PPDefineProdcutionRefactoring instanceVariableNames: 'class source protocols method' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPDefineProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/18/2011 14:34'! onClass: aClass source: aString protocols: anArray ^ self new setClass: aClass; setSource: aString; setProtocols: anArray; yourself! ! !PPDefineProdcutionRefactoring methodsFor: 'private' stamp: 'lr 12/18/2011 15:16'! checkSource | rewriter | method := RBParser parseMethod: source onError: [ :string :position | ^ false ]. rewriter := self sourceRewriter. [ rewriter executeTree: method ] whileTrue: [ method := rewriter tree ]. ^ method selector isUnary! ! !PPDefineProdcutionRefactoring methodsFor: 'preconditions' stamp: 'lr 12/18/2011 15:18'! preconditions ^ (self checkCompositeParser: class) & (RBCondition withBlock: [ self checkSource ] errorString: 'Unable to parse source code')! ! !PPDefineProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 14:31'! setClass: aClass class := self classObjectFor: aClass! ! !PPDefineProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/7/2011 22:07'! setProtocols: anArray protocols := anArray! ! !PPDefineProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/7/2011 18:43'! setSource: aString source := aString! ! !PPDefineProdcutionRefactoring methodsFor: 'private' stamp: 'lr 12/7/2011 22:01'! sourceRewriter ^ RBParseTreeRewriter new replace: '`#literal' with: '`#literal asParser' when: [ :node | (node isLiteralNode and: [ node value isString or: [ node value isCharacter ] ]) and: [ (node parent isNil or: [ node parent isMessage not or: [ node parent selector ~= #asParser ] ]) and: [ (node parents noneSatisfy: [ :each | each isBlock ]) ] ] ]; replaceMethod: '`@method: `@args | `@temps | ``@.statements. ``.statement `{ :node | node isReturn not }' with: '`@method: `@args | `@temps | ``@.statements. ^ ``.statement'; yourself! ! !PPDefineProdcutionRefactoring methodsFor: 'transforming' stamp: 'lr 12/7/2011 22:08'! transform (class definesInstanceVariable: method selector asString) ifFalse: [ class addInstanceVariable: method selector asString ]. class compile: method newSource classified: protocols! ! RBRefactoring subclass: #PPRemoveProdcutionRefactoring instanceVariableNames: 'production class' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPRemoveProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/18/2011 14:34'! onClass: aClass production: aSelector ^ self new setClass: aClass; setProduction: aSelector; yourself! ! !PPRemoveProdcutionRefactoring methodsFor: 'preconditions' stamp: 'lr 12/18/2011 14:49'! preconditions ^ (self checkCompositeParser: class) & (RBCondition definesSelector: production asSymbol in: class) & (RBCondition definesInstanceVariable: production asString in: class)! ! !PPRemoveProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 14:31'! setClass: aClass class := self classObjectFor: aClass! ! !PPRemoveProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/7/2011 18:48'! setProduction: aSymbol production := aSymbol! ! !PPRemoveProdcutionRefactoring methodsFor: 'transforming' stamp: 'lr 12/7/2011 20:18'! transform class removeMethod: production asSymbol. class removeInstanceVariable: production asString! ! RBRefactoring subclass: #PPRenameProdcutionRefactoring instanceVariableNames: 'oldProduction newProduction class' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPRenameProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/18/2011 14:34'! onClass: aClass rename: anOldSelector to: aNewSelector ^ self new setClass: aClass; setOldProduction: anOldSelector; setNewProduction: aNewSelector; yourself! ! !PPRenameProdcutionRefactoring methodsFor: 'preconditions' stamp: 'lr 12/18/2011 14:49'! preconditions ^ self checkCompositeParser: class! ! !PPRenameProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/18/2011 14:31'! setClass: aClass class := self classObjectFor: aClass! ! !PPRenameProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/7/2011 19:09'! setNewProduction: aSymbol newProduction := aSymbol! ! !PPRenameProdcutionRefactoring methodsFor: 'initialization' stamp: 'lr 12/7/2011 19:09'! setOldProduction: aSymbol oldProduction := aSymbol! ! !PPRenameProdcutionRefactoring methodsFor: 'transforming' stamp: 'lr 12/7/2011 21:19'! transform | baseClass oldEnvironment | baseClass := class whoDefinesInstanceVariable: oldProduction asString. self performComponentRefactoring: (RBRenameInstanceVariableRefactoring model: model rename: oldProduction asString to: newProduction asString in: baseClass). oldEnvironment := model environment. model environment: (model environment forClasses: baseClass realClass withAllSubclasses). [ self performComponentRefactoring: (RBRenameMethodRefactoring model: model renameMethod: oldProduction asSymbol in: baseClass to: newProduction asSymbol permutation: #()) ] ensure: [ model environment: oldEnvironment ]! ! !RBRefactoring methodsFor: '*petitgui-utilities' stamp: 'lr 12/18/2011 14:47'! checkCompositeParser: aClass ^ (RBCondition isMetaclass: aClass) not "& RBCondition isSubclass: class of: self compositeParserClass" & (RBCondition new type: (Array with: #subclass with: self compositeParserClass with: aClass) block: [ aClass includesClass: self compositeParserClass ] errorString: aClass printString , ' is <1?:not >a subclass of ' , self compositeParserClass printString)! ! !RBRefactoring methodsFor: '*petitgui-utilities' stamp: 'lr 12/18/2011 14:47'! compositeParserClass ^ self classObjectFor: #PPCompositeParser! ! Object subclass: #PPBrowser instanceVariableNames: 'browser input stream output' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPBrowser commentStamp: 'TudorGirba 10/21/2011 15:38' prior: 0! self open! !PPBrowser class methodsFor: 'accessing' stamp: 'lr 9/25/2011 20:04'! icon ^ (Form extent: 16@16 depth: 32 fromArray: #( 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 1069534679 2139069360 2139069360 2139069360 2139069360 1551866800 1199545264 1451203504 2139069360 2139069360 2139069360 2139069360 2139069360 260021168 8362928 16777215 2139069360 14177 67123041 620771169 1224750945 1845507937 3372234593 3087021921 4278204257 4278204257 4278204257 4278204257 4278204257 3405789025 452999009 16777215 2139069360 14177 117454689 704657249 1325414241 1728067425 2197829473 3288348513 4278204257 4278204257 3758110561 3691001697 4278204257 4278204257 654325601 16777215 2139069360 14177 201340769 822097761 1409300321 1543518049 1811953505 3523229537 4278204257 4278204257 2231383905 3019913057 4278204257 4278204257 620771169 16777215 2139069360 14177 318781281 939538273 1509963617 1862285153 2717923169 3573561185 4278204257 4278204257 3238016865 3640670049 4278204257 4060100449 452999009 16777215 2139069360 1593849697 1862285153 2248161121 2281715553 2751477601 3003135841 3825219425 4278204257 4278204257 4278204257 4278204257 4278204257 1476409185 100677473 16777215 2139069360 33568609 536885089 1157642081 1644181345 1946171233 2214606689 4278204257 4278204257 3389011809 2281715553 2130720609 268449633 16791393 14177 16777215 2139069360 83900257 637548385 1258305377 1543518049 1543518049 1543518049 4278204257 4278204257 2466264929 201340769 14177 14177 14177 14177 16777215 2139069360 151009121 754988897 1375745889 1543518049 1543518049 1543518049 4278204257 4278204257 2298492769 125803440 16777215 16777215 16777215 16777215 16777215 2139069360 234895201 872429409 1426077537 1543518049 1543518049 2902472545 4278204257 4278204257 603993953 75471792 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215 16777215) offset: 0@0)! ! !PPBrowser class methodsFor: 'accessing' stamp: 'lr 9/23/2011 07:38'! label ^ 'PetitParser'! ! !PPBrowser class methodsFor: 'private' stamp: 'lr 9/25/2011 20:02'! menuCommandOn: aBuilder (aBuilder item: self label) parent: #Tools; icon: self icon; action: [ self new open ]! ! !PPBrowser class methodsFor: 'instance-creation' stamp: 'lr 11/6/2009 16:32'! open ^ self new open! ! !PPBrowser methodsFor: 'browse' stamp: 'TudorGirba 10/18/2012 11:49'! browseClassesOn: aBrowser aBrowser tree title: 'Grammars'; format: [ :class | class name ]; children: [ :class | self subclassesOf: class ]; selectionAct: [ self selectedClass removeFromSystem. aBrowser entity: self rootClass ] on: $r entitled: 'remove (x)'; selectionAct: [ self selectedClass browse ] on: $b entitled: 'browse (b)'! ! !PPBrowser methodsFor: 'browse-static' stamp: 'lr 11/20/2009 16:19'! browseCyclesOn: aBrowser aBrowser list title: 'Cycles'; useExplicitNotNil; format: [ :parser | parser displayName ]; display: [ :parsers | self production cycleSet ]! ! !PPBrowser methodsFor: 'browse' stamp: 'lr 4/16/2010 00:02'! browseDynamicOn: aBrowser | tabulator | aBrowser useExplicitNotNil. tabulator := aBrowser tabulator. tabulator title: 'Dynamic'; useExplicitNotNil; row: #input; row: #output. tabulator transmit to: #input; andShow: [ :a | self browseInputOn: a ]. tabulator transmit to: #output; from: #input; andShow: [ :a | self browseOutputOn: a ]. tabulator transmit from: #output; to: #input->#selectionInterval; when: [ :selection | selection notNil ]; transformed: [ :selection | selection second to: selection third ] ! ! !PPBrowser methodsFor: 'browse-static' stamp: 'lr 11/11/2009 20:45'! browseExampleOn: aBrowser aBrowser text title: 'Example'; useExplicitNotNil; display: [ :parsers | self production example ]! ! !PPBrowser methodsFor: 'browse-static' stamp: 'lr 6/26/2010 14:36'! browseFirstOn: aBrowser aBrowser list title: 'First'; useExplicitNotNil; format: [ :parser | parser displayName ]; display: [ :parsers | self production firstSet ]! ! !PPBrowser methodsFor: 'browse-static' stamp: 'lr 6/26/2010 14:37'! browseFollowOn: aBrowser aBrowser list title: 'Follow'; useExplicitNotNil; format: [ :parser | parser displayName ]; display: [ :parsers | | parser | parser := self selectedClass new. parser followSets at: (parser productionAt: self selectedSelector) ifAbsent: [ Array with: nil asParser ] ]! ! !PPBrowser methodsFor: 'browse-static' stamp: 'tg 8/25/2010 11:08'! browseGraphOn: aBrowser aBrowser morph title: 'Graph'; useExplicitNotNil; display: [ :parsers | | morph | morph := ScrollPane new. morph color: Color white. morph scroller addMorph: self production morphicProduction. morph ]! ! !PPBrowser methodsFor: 'browse-dynamic' stamp: 'TudorGirba 12/2/2010 18:36'! browseInputOn: aBrowser aBrowser text useExplicitNotNil; display: [ :class :selector | input ]; selectionPopulate: #selection on: $s entitled: 'Parse (s)' with: [ :presentation | input := presentation text asString. stream := PPBrowserStream on: input. output := self production end parse: stream. output isPetitFailure ifTrue: [ presentation selectionInterval: (output position + 1 to: output position) ]. output ]! ! !PPBrowser methodsFor: 'browse-static' stamp: 'TudorGirba 10/12/2012 16:04'! browseMapOn: aBrowser self class environment at: #GLMMondrianPresentation ifPresent: [ :class | aBrowser roassal title: 'Map'; useExplicitNotNil; painting: [ :view :parsers | self production viewAllNamedParsersOn: view ] ]! ! !PPBrowser methodsFor: 'browse' stamp: 'TudorGirba 12/2/2010 18:12'! browseOn: aComposite aComposite title: self class label; color: Color yellow muchDarker. aComposite row: [ :row | row column: #class; column: #selector ]. aComposite row: [ :row | row column: #part span: 2 ] span: 2. aComposite transmit to: #class; andShow: [ :composite | self browseClassesOn: composite ]. aComposite transmit to: #selector; from: #class; andShow: [ :composite | self browseSelectorsOn: composite ]. aComposite transmit to: #part; from: #class; from: #selector; andShow: [ :composite | self browsePartsOn: composite ]! ! !PPBrowser methodsFor: 'browse-dynamic' stamp: 'TudorGirba 11/28/2010 23:08'! browseOutputOn: aBrowser aBrowser text title: 'Result'; display: [ output ]; act: [:text | output inspect ] entitled: 'Inspect'. aBrowser list title: 'Debugger'; format: [ :each | (String new: 2 * each fourth withAll: $ ) asText , each first, ' - ', each last printString ]; selectionAct: [:list | list selection last inspect ] entitled: 'Inspect token'; display: [ | depth trace | depth := -1. trace := OrderedCollection new. (self production end transform: [ :each | each name notNil ifTrue: [ each >=> [ :s :cc | | t r | depth := depth + 1. trace addLast: (t := Array with: each name with: s position + 1 with: s position with: depth with: Object new with: nil). r := cc value. t at: t size put: r. t at: 3 put: s position. r isPetitFailure ifFalse: [ t at: 1 put: (t at: 1) asText allBold ]. depth := depth - 1. r ] ] ifFalse: [ each ] ]) parse: input. trace ]. aBrowser table title: 'Tally'; column: 'Parser' evaluated: [ :each | each first displayName ]; column: 'Count' evaluated: [ :each | each second printString ]; column: 'Percentage (%)' evaluated: [ :each | each third printString ]; display: [ stream asFrequencyTable ]. aBrowser table title: 'Profile'; column: 'Parser' evaluated: [ :each | each first displayName ]; column: 'Time (ms)' evaluated: [ :each | each second printString ]; column: 'Percentage (%)' evaluated: [ :each | each third printString ]; display: [ stream asTimingTable ]. aBrowser morph title: 'Progress'; display: [ | morph | morph := ScrollPane new. morph color: Color white. morph scroller addMorph: stream asPositionMorph. morph ]! ! !PPBrowser methodsFor: 'browse' stamp: 'TudorGirba 3/5/2011 23:21'! browsePartsOn: aComposite aComposite useExplicitNotNil. aComposite tabbedArrangement. self browseStaticOn: aComposite. self browseDynamicOn: aComposite! ! !PPBrowser methodsFor: 'browse' stamp: 'TudorGirba 10/18/2012 11:50'! browseSelectorsOn: aBrowser aBrowser list title: 'Productions'; format: [ :class | class asString ]; display: [ :class | ((((class allInstVarNames copyWithoutAll: class ignoredNames) copyWithoutAll: self rootClass allInstVarNames) collect: [ :each | each asSymbol ]) select: [ :each | class includesSelector: each ]) asSortedCollection ]; selectionAct: [ Smalltalk tools browser fullOnClass: self selectedClass selector: self selectedSelector ] on: $b entitled: 'browse (b)'; selectionAct: [ | class selector | class := self selectedClass. selector := self selectedSelector. (class instVarNames includes: selector) ifTrue: [ class removeInstVarName: selector ]. class removeSelector: selector. aBrowser entity: self rootModel. self selectedClass: class ] on: $r entitled: 'remove (x)'! ! !PPBrowser methodsFor: 'browse-static' stamp: 'TudorGirba 10/21/2011 14:45'! browseSourceOn: aBrowser aBrowser smalltalkCode title: 'Source'; useExplicitNotNil; display: [ self sourceCode ]; smalltalkClass: [ self selectedClass ]; act: [ :node | | class selector | class := self selectedClass. selector := self sourceCode: node text asString in: class. aBrowser entity: self rootModel. self selectedClass: class. self selectedSelector: selector ] on: $s entitled: 'accept (s)'! ! !PPBrowser methodsFor: 'browse' stamp: 'tg 8/25/2010 11:05'! browseStaticOn: aBrowser aBrowser useExplicitNotNil. aBrowser tabbedArrangement. self browseSourceOn: aBrowser. self browseGraphOn: aBrowser. self browseMapOn: aBrowser. self browseCyclesOn: aBrowser. self browseFirstOn: aBrowser. self browseFollowOn: aBrowser. self browseExampleOn: aBrowser! ! !PPBrowser methodsFor: 'initialize-release' stamp: 'lr 4/14/2010 21:05'! initialize super initialize. input := String new. output := String new. stream := PPBrowserStream on: input! ! !PPBrowser methodsFor: 'public' stamp: 'tg 11/16/2009 15:21'! open browser := GLMTabulator new. self browseOn: browser. browser openOn: self rootModel! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/23/2009 22:24'! production | parser | ^ (parser := self selectedClass new) productionAt: (self selectedSelector ifNil: [ ^ parser ])! ! !PPBrowser methodsFor: 'accessing' stamp: 'lr 11/11/2009 08:23'! rootClass ^ PPCompositeParser! ! !PPBrowser methodsFor: 'accessing' stamp: 'lr 11/11/2009 08:45'! rootModel ^ self subclassesOf: self rootClass! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'! selectedClass ^ ((browser paneNamed: #class) port: #selection) value! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'! selectedClass: aClass ((browser paneNamed: #class) port: #selection) value: aClass! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'! selectedSelector ^ ((browser paneNamed: #selector) port: #selection) value! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 4/15/2010 10:47'! selectedSelector: aSelector ((browser paneNamed: #selector) port: #selection) value: aSelector! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/11/2009 20:42'! sourceCode ^ (self selectedClass ifNil: [ ^ String new ]) sourceCodeAt: (self selectedSelector ifNil: [ #start ]) ifAbsent: [ String new ]! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/13/2009 10:59'! sourceCode: aString in: aClass | tree source selector | tree := RBParser parseMethod: aString onError: [ :msg :pos | nil ]. source := tree isNil ifTrue: [ aString ] ifFalse: [ | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '`#literal' with: '`#literal asParser' when: [ :node | (node isLiteralNode and: [ node value isString or: [ node value isCharacter ] ]) and: [ (node parent isNil or: [ node parent isMessage not or: [ node parent selector ~= #asParser ] ]) and: [ (node parents noneSatisfy: [ :each | each isBlock ]) ] ] ]; replaceMethod: '`@method: `@args | `@temps | ``@.statements. ``.statement `{ :node | node isReturn not }' with: '`@method: `@args | `@temps | ``@.statements. ^ ``.statement'. (rewriter executeTree: tree) ifTrue: [ rewriter tree newSource ] ifFalse: [ aString ] ]. selector := aClass compile: source. (aString numArgs = 0 and: [ (aClass allInstVarNames includes: selector) not ]) ifTrue: [ aClass addInstVarName: selector asString ]. ^ selector! ! !PPBrowser methodsFor: 'querying' stamp: 'lr 11/11/2009 08:44'! subclassesOf: aBehavior ^ aBehavior subclasses asSortedCollection: [ :a :b | a name < b name ]! ! Object subclass: #PPParserDebuggerResult instanceVariableNames: 'parser result children parent start end' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPParserDebuggerResult commentStamp: 'TudorGirba 3/8/2011 10:03' prior: 0! This class is meant to be used as a model for running a parser over a given stream. You create it via parse:with: class side method. For example: self parse: '1 + 2' with: PPArithmeticParser new. Instance Variables: parser result children parent ! !PPParserDebuggerResult class methodsFor: 'instance creation' stamp: 'TudorGirba 12/6/2011 20:42'! parse: aStream with: parser | root newParser | root := self new. newParser := parser transform: [:each | each name isNil ifTrue: [ each ] ifFalse: [ each >=> [:stream :continuation | | result child | child := PPParserDebuggerResult new parser: each; parent: root. root := root children add: child. child start: stream position + 1. result := continuation value. child end: stream position. root result: result. root := root parent. result ]]]. newParser parse: aStream. ^ root children first! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/7/2011 23:08'! children ^ children! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/7/2011 23:08'! children: anObject children := anObject! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 12/6/2011 20:40'! end ^ end! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 12/6/2011 20:40'! end: anObject end := anObject! ! !PPParserDebuggerResult methodsFor: 'printing' stamp: 'TudorGirba 3/8/2011 10:54'! formattedText ^ self result isPetitFailure ifTrue: [ Text string: self printString attribute: TextColor gray ] ifFalse: [ self printString]! ! !PPParserDebuggerResult methodsFor: 'initialization' stamp: 'TudorGirba 3/8/2011 07:32'! initialize children := OrderedCollection new! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/8/2011 07:29'! parent ^ parent! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/8/2011 07:29'! parent: anObject parent := anObject! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/7/2011 23:08'! parser ^ parser! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/7/2011 23:08'! parser: anObject parser := anObject! ! !PPParserDebuggerResult methodsFor: 'printing' stamp: 'TudorGirba 3/8/2011 10:55'! printOn: aStream aStream nextPutAll: self parser name; nextPutAll: ' - '; nextPutAll: self result printString! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/7/2011 23:08'! result ^ result! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 3/7/2011 23:08'! result: anObject result := anObject! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 12/6/2011 20:40'! start ^ start! ! !PPParserDebuggerResult methodsFor: 'accessing' stamp: 'TudorGirba 12/6/2011 20:40'! start: anObject start := anObject! ! Object subclass: #PPRefactoringUtils instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPRefactoringUtils methodsFor: 'private refactoring' stamp: 'TudorGirba 11/28/2012 22:58'! handleError: anException anException actionBlock isNil ifTrue: [ UIManager default inform: anException messageText ] ifFalse: [ (UIManager default confirm: anException messageText) ifTrue: [ anException actionBlock value ] ]. anException return! ! !PPRefactoringUtils methodsFor: 'private refactoring' stamp: 'TudorGirba 11/28/2012 22:58'! handleWarning: anException | message | message := (anException messageText endsWith: '?') ifTrue: [ anException messageText ] ifFalse: [ anException messageText , String cr , 'Do you want to proceed?' ]. (UIManager default confirm: message) ifTrue: [ anException resume ] ifFalse: [ anException return ]! ! !PPRefactoringUtils methodsFor: 'private refactoring' stamp: 'TudorGirba 11/28/2012 22:58'! performRefactoring: aRefactoring [ [ aRefactoring execute ] on: RBRefactoringWarning do: [ :exception | self handleWarning: exception ] ] on: RBRefactoringError do: [ :exception | self handleError: exception ]! ! !PPRefactoringUtils methodsFor: 'private refactoring' stamp: 'TudorGirba 11/28/2012 22:58'! performRenameProduction: oldName from: class | refactoring newName | newName := UIManager default request: 'Production name:' initialAnswer: oldName. refactoring := PPRenameProdcutionRefactoring onClass: class rename: oldName to: newName. self performRefactoring: refactoring. ^ refactoring! ! Object subclass: #PPTextHighlighter instanceVariableNames: 'parser attributeMapper' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPTextHighlighter commentStamp: '' prior: 0! This is a utility class for creating a highlighted text. For this we need: - a parser: PPParser - an attributeMapper Here is a template to use it: PPTextHighlighter new parser: YourParser new; color: 'tokenName1' with: Color blue; color: 'tokenName2' with: Color gray; highlight: string.! !PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/27/2010 23:41'! addAttribute: aTextAttribute for: anElementString | attributes | attributes := self attributeMapper at: anElementString ifAbsentPut: [OrderedCollection new]. attributes add: aTextAttribute! ! !PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:09'! attributeMapper "returns a dictionary with keys corresponding to parser names and values corresponding to a collection of TextAttributes" ^ attributeMapper! ! !PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:07'! attributeMapper: aDictionary attributeMapper := aDictionary! ! !PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/27/2010 23:42'! bold: anElementString self addAttribute: TextEmphasis bold for: anElementString! ! !PPTextHighlighter methodsFor: 'public' stamp: 'tg 7/28/2010 08:06'! color: anElementString with: aColor self addAttribute: (TextColor new color: aColor) for: anElementString! ! !PPTextHighlighter methodsFor: 'public' stamp: 'TudorGirba 4/30/2011 21:26'! highlight: aString | text highlighter | text := aString asText. highlighter := parser transform: [ :p | attributeMapper at: p name ifPresent: [ :attributes | p token ==> [ :token | attributes do: [:each | text addAttribute: each from: token start to: token stop ] ] ] ifAbsent: [ p ] ]. highlighter parse: text. ^ text! ! !PPTextHighlighter methodsFor: 'initialization' stamp: 'tg 7/27/2010 23:09'! initialize parser := #any asParser. attributeMapper := Dictionary new! ! !PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:06'! parser ^ parser! ! !PPTextHighlighter methodsFor: 'accessing' stamp: 'tg 7/27/2010 23:21'! parser: aParser parser := aParser! !