SystemOrganization addCategory: #'PetitGui-Core'! !PPFailingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:43'! displayColor ^ Color red! ! !PPFailingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:43'! displayName ^ message! ! !PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:43'! morphicShapeSeen: aSet depth: anInteger aSet add: self. ^ parser morphicShapeSeen: aSet depth: anInteger! ! !PPChoiceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/11/2009 20:54'! exampleOn: aStream "If there is already a lot written, try to pick an empty possiblity." aStream position > 512 ifTrue: [ parsers detect: [ :each | each isNullable ] ifNone: [ ^ self ] ]. parsers atRandom exampleOn: aStream! ! !PPChoiceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/7/2009 15:09'! morphicShapeSeen: aSet depth: anInteger | morph | ^ (anInteger < 1 or: [ aSet includes: self ]) ifTrue: [ super morphicShapeSeen: aSet depth: anInteger ] ifFalse: [ aSet add: self. morph := RectangleMorph new. morph borderWidth: 0; color: Color transparent; layoutPolicy: TableLayout new; cellPositioning: #leftCenter; listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #spaceFill; layoutInset: 5; cellInset: 5. self children do: [ :each | morph addMorphBack: (each morphicShapeSeen: aSet depth: anInteger - 1) ]. morph ]! ! !PPEpsilonParser methodsFor: '*petitgui-mondrian' stamp: 'lr 11/6/2009 18:42'! displayName ^ 'epsilon'! ! !PPLiteralParser methodsFor: '*petitgui-mondrian' stamp: 'lr 11/7/2009 13:31'! displayName ^ literal asString! ! !PPLiteralSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPutAll: literal! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/6/2009 18:31'! displayColor ^ self isUnresolved ifTrue: [ Color red ] ifFalse: [ self isNullable ifTrue: [ Color blue ] ifFalse: [ Color black ] ]! ! !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-accessing' stamp: 'lr 11/7/2009 14:55'! morphicShape ^ self morphicShapeSeen: IdentitySet new depth: 2! ! !PPParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/7/2009 13:25'! morphicShapeSeen: aSet depth: anInteger ^ TextMorph new centered; autoFit: true; borderWidth: 1; borderColor: Color black; backgroundColor: Color white; textColor: (self isTerminal ifTrue: [ Color purple ] ifFalse: [ Color blue ]); contents: self displayName; yourself! ! !PPSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:24'! exampleOn: aStream parsers do: [ :each | each exampleOn: aStream ]! ! !PPSequenceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/7/2009 15:11'! morphicShapeSeen: aSet depth: anInteger | morph | ^ (anInteger < 1 or: [ aSet includes: self ]) ifTrue: [ super morphicShapeSeen: aSet depth: anInteger ] ifFalse: [ aSet add: self. morph := RectangleMorph new. morph borderWidth: 0; color: Color transparent; layoutPolicy: TableLayout new; cellPositioning: #leftCenter; listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #spaceFill. morph addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) makeForwardArrow. self children do: [ :each | morph addMorphBack: (each morphicShapeSeen: aSet depth: anInteger - 1) ] separatedBy: [ morph addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) makeForwardArrow ]. morph addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) "vResizing: #spaceFill;" makeForwardArrow; yourself). morph ]! ! !PPFlattenParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:28'! exampleOn: aStream super exampleOn: aStream. aStream space! ! Object subclass: #PPBrowser instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'PetitGui-Core'! !PPBrowser class methodsFor: 'instance-creation' stamp: 'lr 11/6/2009 16:32'! open ^ self new open! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 20:48'! browseClassesOn: aBrowser aBrowser tree title: 'Classes'; format: [ :class | class name ]; children: [ :class | self subclassesOf: class ]; act: [ self selectedClass removeFromSystem. aBrowser entity: self rootClass ] on: $r entitled: 'remove (x)'; act: [ StandardToolSet browse: self selectedClass selector: nil ] on: $b entitled: 'browse (b)'! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 20:45'! browseExampleOn: aBrowser aBrowser text title: 'Example'; useExplicitNotNil; display: [ :parsers | self production example ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 20:44'! browseFirstOn: aBrowser aBrowser list title: 'First'; useExplicitNotNil; format: [ :parser | parser displayName ]; display: [ :parsers | self production firstSet ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 20:44'! browseFollowOn: aBrowser aBrowser list title: 'Follow'; useExplicitNotNil; format: [ :parser | parser displayName ]; display: [ :parsers | self production followSet ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 20:43'! browseGraphOn: aBrowser aBrowser morph title: 'Graph'; useExplicitNotNil; display: [ :parsers | | morph | morph := ScrollPane new. morph scroller addMorph: self production morphicShape. morph ]! ! !PPBrowser methodsFor: 'browse' stamp: 'lr 11/11/2009 20:46'! browseOn: aBrowser aBrowser title: 'PetitParser Browser'; color: Color yellow muchDarker. aBrowser row: [ :row | row column: #classes; column: #selectors ]. aBrowser row: [ :row | row column: #actions span: 2 ] span: 2. aBrowser showOn: #classes; using: [ self browseClassesOn: aBrowser ]. aBrowser showOn: #selectors; from: #classes; using: [ self browseSelectorsOn: aBrowser ]. aBrowser showOn: #actions; from: #classes; from: #selectors; using: [ self browseSourceOn: aBrowser. self browseTestOn: aBrowser. self browseGraphOn: aBrowser. self browseExampleOn: aBrowser. self browseFirstOn: aBrowser. self browseFollowOn: aBrowser ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 09:16'! browseSelectorsOn: aBrowser aBrowser list title: 'Selectors'; format: [ :class | class asString ]; display: [ :class | (((class allInstVarNames copyWithoutAll: self rootClass allInstVarNames) collect: [ :each | each asSymbol ]) select: [ :each | class includesSelector: each ]) asSortedCollection ]; act: [ StandardToolSet browse: self selectedClass selector: self selectedSelector ] on: $b entitled: 'browse (b)'; act: [ | 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-parts' stamp: 'lr 11/13/2009 08:54'! browseSourceOn: aBrowser aBrowser text title: 'Source'; useExplicitNotNil; display: [ self sourceCode ]; forSmalltalk: [ 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-parts' stamp: 'lr 11/11/2009 20:45'! browseTestOn: aBrowser | table contents | table := aBrowser table. table title: 'Test'; useExplicitNotNil. table row: #input; row: #output. contents := String new. table showOn: #input; using: [ table text display: [ :parsers | contents ]; update: #selection on: $s entitled: 'parse (s)' with: [ :presentation | contents := presentation text copy ] ]. table showOn: #output; from: #outer -> #entity; from: #input; using: [ table text useExplicitNotNil; when: [ :parsers | parsers notNil ]; display: [ | result | result := self production parse: contents asParserStream. result isFailure ifTrue: [ ]. result ] ]! ! !PPBrowser methodsFor: 'public' stamp: 'lr 11/11/2009 09:05'! open browser := GLMTableLayoutBrowser new. self browseOn: browser. browser openOn: self rootModel! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/11/2009 09:06'! production | parser selector | parser := self selectedClass new. selector := self selectedSelector ifNil: [ ^ parser ]. ^ parser instVarNamed: selector asString! ! !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 11/11/2009 09:14'! selectedClass ^ ((browser paneNamed: #classes) port: #selection) value! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/11/2009 09:06'! selectedClass: aClass ((browser paneNamed: #classes) port: #selection) value: aClass! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/11/2009 09:07'! selectedSelector ^ ((browser paneNamed: #selectors) port: #selection) value! ! !PPBrowser methodsFor: 'accessing-view' stamp: 'lr 11/11/2009 09:07'! selectedSelector: aSelector ((browser paneNamed: #selectors) 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 ]! ! !PPNotParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/11/2009 21:09'! exampleOn: aStream! ! !PPPredicateParser methodsFor: '*petitgui-mondrian' stamp: 'lr 11/7/2009 14:21'! displayName ^ predicateMessage! ! !PPPredicateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/11/2009 20:58'! 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 | predicate value: char ]. normal := valid select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ]. aStream nextPut: (normal isEmpty ifTrue: [ valid atRandom ] ifFalse: [ normal atRandom ])! ! !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 ]! ! !PPRepeatingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/7/2009 14:56'! morphicShapeSeen: aSet depth: anInteger | morph | ^ (anInteger < 1 or: [ aSet includes: self ]) ifTrue: [ super morphicShapeSeen: aSet depth: anInteger ] ifFalse: [ aSet add: self. morph := RectangleMorph new. morph borderWidth: 1; color: Color transparent; layoutPolicy: TableLayout new; listDirection: #leftToRight; wrapCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 0 @ 5. morph addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) makeForwardArrow. morph addMorphBack: (parser morphicShapeSeen: aSet depth: anInteger - 1). morph addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1) makeForwardArrow. morph ]! ! !PPDelegateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:27'! exampleOn: aStream parser exampleOn: aStream! ! !PPDelegateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/7/2009 14:58'! morphicShapeSeen: aSet depth: anInteger aSet add: self. ^ parser morphicShapeSeen: aSet depth: anInteger! ! !PPLiteralObjectParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPut: literal! !