SystemOrganization addCategory: #'PetitGui-Core'! !PPChoiceParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:24'! exampleOn: aStream 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 ]! ! !PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:44'! exampleOn: aStream! ! !PPAndParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:43'! morphicShapeSeen: aSet depth: anInteger aSet add: self. ^ parser morphicShapeSeen: aSet depth: anInteger! ! !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 ]! ! 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 09:16'! browseClassesOn: aBrowser aBrowser tree title: 'Classes'; format: [ :class | class name ]; children: [ :class | self subclassesOf: class ]; act: [ StandardToolSet browse: self selectedClass selector: nil ] on: $b entitled: 'browse (b)'; act: [ self selectedClass removeFromSystem. aBrowser entity: self rootClass ] on: $r entitled: 'remove (x)'! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 09:15'! browseExampleOn: aBrowser aBrowser text title: 'Example'; display: [ :parsers | self production example ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 09:14'! browseFirstOn: aBrowser aBrowser list title: 'First'; format: [ :parser | parser displayName ]; display: [ :parsers | self production firstSet ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 09:15'! browseFollowOn: aBrowser aBrowser list title: 'Follow'; format: [ :parser | parser displayName ]; display: [ :parsers | self production followSet ]! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 09:14'! browseGraphOn: aBrowser aBrowser morph title: 'Graph'; display: [ :parsers | | morph | morph := ScrollPane new. morph scroller addMorph: self production morphicShape. morph ]! ! !PPBrowser methodsFor: 'browse' stamp: 'lr 11/11/2009 09:12'! browseOn: aBrowser aBrowser title: 'PetitParser Browser'; color: Color purple lighter lighter. 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/11/2009 09:11'! browseSourceOn: aBrowser aBrowser text title: 'Source'; forSmalltalk: [ self selectedClass ]; display: [ self sourceCode ]; act: [ :node | | class selector | class := self selectedClass. selector := class compile: node text asString. (selector numArgs = 0 and: [ (class allInstVarNames includes: selector) not ]) ifTrue: [ class addInstVarName: selector asString ]. aBrowser entity: self rootModel. self selectedClass: class. self selectedSelector: selector ] on: $s entitled: 'accept (s)'! ! !PPBrowser methodsFor: 'browse-parts' stamp: 'lr 11/11/2009 09:06'! browseTestOn: aBrowser | browser contents | browser := aBrowser table. browser title: 'Test'; row: #input; row: #output. contents := String new. browser showOn: #input; using: [ browser text display: [ :parsers | contents ]; update: #selection on: $s entitled: 'parse (s)' with: [ :presentation | contents := presentation text copy ] ]. browser showOn: #output; from: #outer -> #entity; from: #input; using: [ browser 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 09:11'! sourceCode ^ self selectedClass sourceCodeAt: (self selectedSelector ifNil: [ #start ]) ifAbsent: [ String new ]! ! !PPBrowser methodsFor: 'querying' stamp: 'lr 11/11/2009 08:44'! subclassesOf: aBehavior ^ aBehavior subclasses asSortedCollection: [ :a :b | a name < b name ]! ! !PPFlattenParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:28'! exampleOn: aStream super exampleOn: aStream. aStream space! ! !PPPredicateParser methodsFor: '*petitgui-mondrian' stamp: 'lr 11/7/2009 14:21'! displayName ^ predicateMessage! ! !PPPredicateParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:34'! exampleOn: aStream | 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 ])! ! !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! ! !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! ! !PPRepeatingParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:42'! exampleOn: aStream (min to: (max min: min + 5)) atRandom timesRepeat: [ 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 ]! ! !PPLiteralObjectParser methodsFor: '*petitgui-accessing' stamp: 'lr 11/9/2009 14:25'! exampleOn: aStream aStream nextPut: literal! !