gui/PPDefineProdcutionRefactoring.st
author sr
Wed, 04 Jul 2018 15:30:19 +0200
changeset 611 38338f2de417
parent 336 ce1f4383ef4d
permissions -rw-r--r--
build order was wrong
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
336
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/petitparser/gui' }"
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
Refactoring subclass:#PPDefineProdcutionRefactoring
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:'class source protocols method'
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'PetitGui-Refactoring'
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
!PPDefineProdcutionRefactoring class methodsFor:'instance creation'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
onClass: aClass source: aString protocols: anArray
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
	^ self new
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
		setClass: aClass;
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
		setSource: aString;
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
		setProtocols: anArray;
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
		yourself
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!PPDefineProdcutionRefactoring methodsFor:'accessing'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
selector
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
	^ method selector
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
!PPDefineProdcutionRefactoring methodsFor:'initialization'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
setClass: aClass
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	class := self classObjectFor: aClass
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
setProtocols: anArray
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
	protocols := anArray
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
setSource: aString
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
	source := aString
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
!PPDefineProdcutionRefactoring methodsFor:'preconditions'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
preconditions
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
	^ (self checkCompositeParser: class)
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
		& (RBCondition withBlock: [ self checkSource ] errorString: 'Unable to parse source code')
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
!PPDefineProdcutionRefactoring methodsFor:'private'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
checkSource
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
	| rewriter |
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
	method := RBParser
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
		parseMethod: source
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
		onError: [ :string :position | ^ false ].
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
	rewriter := self sourceRewriter.
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
	[ rewriter executeTree: method ]
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
		whileTrue: [ method := rewriter tree ].
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
	^ method selector isUnary
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
sourceRewriter
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
        ^ ParseTreeRewriter new
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
                replace: '`#literal' with: '`#literal asParser' when: [ :node |
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
                        (node isLiteralNode and: [ node value isString or: [ node value isCharacter ] ])
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
                                and: [ (node parent isNil or: [ node parent isMessage not or: [ node parent selector ~= #asParser ] ])
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
                                and: [ (node parents noneSatisfy: [ :each | each isBlock ]) ] ] ];
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
                replaceMethod: '`@method: `@args | `@temps | ``@.statements. ``.statement `{ :node | node isReturn not }' 
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
                        with: '`@method: `@args | `@temps | ``@.statements. ^ ``.statement';
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
                yourself
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
!PPDefineProdcutionRefactoring methodsFor:'transforming'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
transform
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
	(class definesInstanceVariable: method selector asString)
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
		ifFalse: [ class addInstanceVariable: method selector asString ].
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
	class compile: method newSource classified: protocols
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
!PPDefineProdcutionRefactoring class methodsFor:'documentation'!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
version
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPDefineProdcutionRefactoring.st,v 1.1 2014-03-04 21:15:26 cg Exp $'
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
!
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
version_CVS
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPDefineProdcutionRefactoring.st,v 1.1 2014-03-04 21:15:26 cg Exp $'
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
! !
ce1f4383ef4d initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89