SystemOrganization addCategory: #'PetitGui-Core'! SystemOrganization addCategory: #'PetitGui-Refactoring'! !PPTrimmingParser methodsFor: '*petitgui-accessing' stamp: 'lr 4/14/2010 20:48'! exampleOn: aStream super exampleOn: aStream. aStream nextPut: Character space! ! TestCase subclass: #PPGrammarRefactoringTest instanceVariableNames: 'refactoring' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !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' stamp: 'lr 12/7/2011 22:14'! 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 selector = #function! ! !PPGrammarRefactoringTest methodsFor: 'testing' 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' stamp: 'lr 12/7/2011 22:22'! 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 selector = #add. self assert: self changes last class = RBRemoveMethodChange. self assert: self changes last selector = #addition! ! TestCase subclass: #PPParserDebuggerResultTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !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 ]! ! !PPEndOfInputParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:18'! displayDescription ^ 'end of input'! ! !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 ])! ! !PPLiteralParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:19'! displayName ^ literal printString! ! 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! ! !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 ] ]! ! !PPLiteralSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPutAll: literal! ! !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! ! GLMGlobalBrowserTemplate subclass: #PPAllParsersBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPAllParsersBrowser commentStamp: 'TudorGirba 3/4/2011 18:55' prior: 0! self open! !PPAllParsersBrowser methodsFor: 'building' stamp: 'TudorGirba 12/6/2011 22:45'! buildBrowser "self open" browser := GLMTabulator new. browser title: 'PetitParser Browser'. browser row: #parser; row: #classes size: 25. browser transmit to: #classes; andShow: [:a | self classesIn: a ]. browser transmit to: #parser; from: #classes; andShow: [:a | a custom: PPParserBrowser new browser noTitle ]. ^ browser! ! !PPAllParsersBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/4/2011 00:33'! classesIn: composite composite dropDownList display: [ :class | class allSubclasses asSortedCollection: [ :a :b | a name < b name ] ]! ! !PPAllParsersBrowser methodsFor: 'opening' stamp: 'TudorGirba 3/4/2011 18:27'! entity ^ PPCompositeParser! ! !PPLiteralObjectParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPut: literal! ! RBRefactoring subclass: #PPGrammarRefactoring instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! PPGrammarRefactoring subclass: #PPDefineProdcutionRefactoring instanceVariableNames: 'source protocols method' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPDefineProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/7/2011 22:07'! onClass: aClass source: aString protocols: anArray ^ (self onClass: aClass) setSource: aString; setProtocols: anArray; yourself! ! !PPDefineProdcutionRefactoring methodsFor: 'private' stamp: 'lr 12/7/2011 22:01'! checkSource | rewriter | method := RBParser parseMethod: source onError: [ :string :position | ^ false ]. ((rewriter := self sourceRewriter) executeTree: method) ifTrue: [ method := rewriter tree ]. ^ method selector isUnary! ! !PPDefineProdcutionRefactoring methodsFor: 'preconditions' stamp: 'lr 12/7/2011 20:57'! preconditions ^ super preconditions & (RBCondition withBlock: [ self checkSource ] errorString: 'Unable to parse source code')! ! !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! ! !PPGrammarRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/7/2011 21:16'! onClass: aClass ^ self new setClass: aClass; yourself! ! !PPGrammarRefactoring methodsFor: 'preconditions' stamp: 'lr 12/7/2011 18:17'! preconditions ^ (RBCondition isMetaclass: class) not & (RBCondition isSubclass: class of: self rootClass)! ! !PPGrammarRefactoring methodsFor: 'utilities' stamp: 'lr 12/7/2011 18:17'! rootClass ^ self classObjectFor: #PPCompositeParser! ! !PPGrammarRefactoring methodsFor: 'initialization' stamp: 'lr 12/7/2011 18:09'! setClass: aClass class := self classObjectFor: aClass! ! PPGrammarRefactoring subclass: #PPRemoveProdcutionRefactoring instanceVariableNames: 'production' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPRemoveProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/7/2011 21:17'! onClass: aClass production: aSelector ^ (self onClass: aClass) setProduction: aSelector; yourself! ! !PPRemoveProdcutionRefactoring methodsFor: 'preconditions' stamp: 'lr 12/7/2011 20:18'! preconditions ^ super preconditions & (RBCondition definesSelector: production asSymbol in: class) & (RBCondition definesInstanceVariable: production asString in: class)! ! !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! ! PPGrammarRefactoring subclass: #PPRenameProdcutionRefactoring instanceVariableNames: 'oldProduction newProduction' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Refactoring'! !PPRenameProdcutionRefactoring class methodsFor: 'instance creation' stamp: 'lr 12/7/2011 21:18'! onClass: aClass rename: anOldSelector to: aNewSelector ^ (self onClass: aClass) setOldProduction: anOldSelector; setNewProduction: aNewSelector; yourself! ! !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 ]! ! !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! ! !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-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: 'tg 8/25/2010 00:31'! namedParsersDo: aBlock seen: aSet self children do: [ :each | (aSet includes: each) ifTrue: [ ^ self ]. 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 12/6/2011 07:43'! viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view view shape rectangle text: #displayName; borderColor: [:each | (aCollectionOfNames includes: each name) ifTrue: [Color red] ifFalse: [Color transparent]]. view interaction popupText: aBlock. view nodes: (self allParsers select: [:each | each name isEmptyOrNil not ]). view edgesToAll: #namedParsers. view horizontalDominanceTreeLayout verticalGap: 10; layered! ! !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 ] ]! ! GLMBrowserTemplate subclass: #PPParserBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPParserBrowser commentStamp: 'TudorGirba 10/21/2011 14:47' prior: 0! self openOn: PPArithmeticParser! !PPParserBrowser methodsFor: 'building' stamp: 'TudorGirba 12/6/2011 22:33'! buildBrowser "self openOn: PPArithmeticParser" browser := GLMTabulator new. browser title: [:each | each name]. browser column: #productions ; column: #workspace span: 2. browser transmit to: #productions; andShow: [:a | self productionsIn: a ]. browser transmit to: #workspace; fromOutsidePort: #entity; from: #productions; andShow: [:a | self workspaceIn: a ]. 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: 'private building' stamp: 'TudorGirba 12/3/2011 23:49'! exampleIn: composite composite text title: 'Example'; useExplicitNotNil; display: [ :class :productionSelector | (self production: productionSelector from: class) example ]! ! !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 refactoring' stamp: 'lr 12/10/2011 10:03'! handleError: anException self halt. anException actionBlock isNil ifTrue: [ UIManager default inform: anException messageText ] ifFalse: [ (UIManager default confirm: anException messageText) ifTrue: [ anException actionBlock value ] ]. anException return! ! !PPParserBrowser methodsFor: 'private refactoring' stamp: 'lr 12/10/2011 10:04'! 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 ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/6/2011 22:45'! inspectorIn: composite composite dynamic title: 'Inspector'; display: [ :class :parser | | wrapperBrowser | wrapperBrowser := GLMTabulator new. wrapperBrowser column: #wrapped. wrapperBrowser transmit to: #wrapped; andShow: [ :a | a custom: PPParserInspector new browser noTitle ]. wrapperBrowser startOn: (class new productionAt: parser) ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/6/2011 07:45'! mapIn: composite self class environment at: #GLMMondrianPresentation ifPresent: [ :cls | composite mondrian 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 refactoring' stamp: 'lr 12/10/2011 10:03'! performRefactoring: aRefactoring [ [ aRefactoring execute ] on: RBRefactoringWarning do: [ :exception | self handleWarning: exception ] ] on: RBRefactoringError do: [ :exception | self handleError: exception ]! ! !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: 'lr 12/10/2011 10:08'! productionsIn: composite composite list title: [ :class | class name ]; format: [ :class | class asString ]; display: [ :class | self productionSelectorsFrom: class ]; shouldValidate: true; "Doru: These menus should be built dynamically: title and enabled status should adapt" selectionAct: [ :list :class | RBRefactoryChangeManager instance redoOperation. list pane browser update ] "enabled: RBRefactoryChangeManager instance hasRedoableOperations" entitled: 'Redo' " , RBRefactoryChangeManager instance redoChange"; selectionAct: [ :list :class | RBRefactoryChangeManager instance undoOperation. list pane browser update ] "enabled: RBRefactoryChangeManager instance hasUndoableOperations" entitled: 'Undo ' " , RBRefactoryChangeManager instance undoChange "; "Doru: Need a horizontal ruler here" selectionAct: [ :list :class | self performRefactoring: (PPRenameProdcutionRefactoring onClass: class rename: list selection to: (UIManager default request: 'Production name:' initialAnswer: list selection)). list pane browser update ] on: $r entitled: 'Rename (r)'; selectionAct: [ :list :class | self performRefactoring: (PPRemoveProdcutionRefactoring onClass: class production: list selection). list pane browser update ] on: $x entitled: 'Remove (x)'; "Doru: Need a horizontal ruler here" selectionAct: [ :list :class | StandardToolSet browse: class selector: list selection ] on: $b entitled: 'Browse (b)'! ! !PPParserBrowser methodsFor: 'private building' stamp: 'TudorGirba 12/6/2011 07:45'! sourceCodeFrom: class selector: production ^ class sourceCodeAt: (production ifNil: [ #start ]) ifAbsent: [ String new ]! ! !PPParserBrowser methodsFor: 'private building' stamp: 'lr 12/10/2011 10:09'! sourceIn: composite composite smalltalkCode title: 'Source'; useExplicitNotNil; display: [ :class :production | self sourceCodeFrom: class selector: production ]; smalltalkClass: [ :class | class ]; act: [ :text :class :production | | selector refactoring | refactoring := PPDefineProdcutionRefactoring onClass: class source: text text asString protocols: #(grammar). self 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/6/2011 20:47'! workspaceIn: composite self sourceIn: composite. self graphIn: composite. self mapIn: composite. self exampleIn: composite. self inspectorIn: composite. ! ! GLMBrowserTemplate 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 methodsFor: 'building' stamp: 'TudorGirba 12/6/2011 22:36'! buildBrowser "self openOn: PPArithmeticParser new" browser := GLMTabulator new. browser title: [:each | 'Parser Inspector on ', (each name ifNil: [each class name])]. browser row: #sample; row: #inspectors. (browser transmit) to: #sample; andShowIfNone: [ :a | self sampleIn: a ]. (browser transmit) from: #sample; "result" passivelyFrom: #sample port: #text; "sample text" from: #sample port: #stream; "parser stream" fromOutside: #entity; "parser" to: #inspectors; andShow: [ :a | self inspectorsIn: a ]. browser transmit from: #inspectors; to: #sample port: #selectionInterval; transformed: [:debugResult | debugResult start to: debugResult end ]. ^ browser! ! !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/3/2011 21:59'! 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 ]; 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/3/2011 21:56'! resultIn: composite (composite text) title: 'Result'; display: [ :result :sample :stream :parser | result ]; act: [ :text | text entity inspect ] icon: GLMUIThemeExtraIcons glamorousInspect entitled: 'Inspect'! ! !PPParserInspector methodsFor: 'private building' stamp: 'TudorGirba 12/3/2011 21:57'! sampleIn: composite (composite text) title: 'Sample'; display: ''; 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/3/2011 21:59'! 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 ]; showOnly: 50! ! !PPUnresolvedParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:15'! displayColor ^ Color red! ! !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 ]! ! !PPPluggableParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/13/2009 14:41'! displayName ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]! ! 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 11/28/2010 22:43'! 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: [ StandardToolSet browse: self selectedClass selector: nil ] 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: 'lr 9/12/2011 18:29'! browseMapOn: aBrowser self class environment at: #GLMMondrianPresentation ifPresent: [ :class | aBrowser mondrian 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 12/2/2010 12:21'! 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: [ StandardToolSet browse: 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: #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! ! !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! !