SystemOrganization addCategory: #'LanguageBoxes-Core'! SystemOrganization addCategory: #'LanguageBoxes-Helvetia'! SystemOrganization addCategory: #'LanguageBoxes-OmniBrowser'! SystemOrganization addCategory: #'LanguageBoxes-Grammar-Smalltalk'! SystemOrganization addCategory: #'LanguageBoxes-Grammar-SQL'! SystemOrganization addCategory: #'LanguageBoxes-Grammar-XML'! SystemOrganization addCategory: #'LanguageBoxes-Tests-SQL'! PPCompositeParserTest subclass: #LBSqlGrammarTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Tests-SQL'! LBSqlGrammarTests subclass: #LBSqlCompilerTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Tests-SQL'! !LBSqlCompilerTests methodsFor: 'accessing' stamp: 'lr 6/30/2009 13:48'! parserClass ^ LBSqlCompiler! ! !LBSqlGrammarTests methodsFor: 'accessing' stamp: 'lr 6/30/2009 12:00'! parserClass ^ LBSqlGrammar! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:17'! testCreate1 self parse: 'CREATE foo (a) WITH VALUES (1)'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:17'! testCreate2 self parse: 'CREATE foo (a, b) WITH VALUES (1, 2)'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:24'! testCreate3 self parse: 'CREATE foo (a, b, c) WITH VALUES (1, 2, "foo bar")'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:16'! testDelete1 self parse: 'DELETE FROM foo'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:24'! testDelete2 self parse: 'DELETE FROM "ZorkCommander" WHERE a = 43'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:24'! testInsert1 self parse: 'INSERT INTO foo (a) VALUES ("This is a longer string")'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:24'! testInsert2 self parse: 'INSERT INTO foo ("a", b) VALUES (1, "2")'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:10'! testInsert3 self parse: 'INSERT INTO foo (a, b, c) VALUES (1, 2, 3)'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:00'! testSelect1 self parse: 'SELECT * FROM foo'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:01'! testSelect2 self parse: 'SELECT a, b, c FROM foo'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:24'! testSelect3 self parse: 'SELECT * FROM foo WHERE a !!= b'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:01'! testSelect4 self parse: 'SELECT * FROM foo LIMIT 13'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:24'! testSelect5 self parse: 'SELECT * FROM foo WHERE a > 12 LIMIT 13'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:38'! testUpdate1 self parse: 'UPDATE foo SET a = 12'! ! !LBSqlGrammarTests methodsFor: 'testing' stamp: 'lr 6/30/2009 12:25'! testUpdate2 self parse: 'UPDATE foo SET a = 12 WHERE b >= 13'! ! LBSqlGrammarTests subclass: #LBSqlHighlighterTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Tests-SQL'! !LBSqlHighlighterTests methodsFor: 'accessing' stamp: 'lr 6/30/2009 13:48'! parserClass ^ LBSqlHighlighter! ! OBCommand subclass: #LBCmdProvider instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! LBCmdProvider subclass: #LBCmdActivate instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdActivate methodsFor: 'execution' stamp: 'lr 6/23/2009 11:31'! execute self languageBox active: self languageBox isActive not! ! !LBCmdActivate methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:08'! label ^ (ORChangesBrowser displayDiffs ifTrue: [ '' ] ifFalse: [ '']) , 'Active'! ! LBCmdProvider subclass: #LBCmdInspect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdInspect methodsFor: 'execution' stamp: 'lr 6/23/2009 11:32'! execute self languageBox explore! ! !LBCmdInspect methodsFor: 'accessing' stamp: 'lr 10/30/2008 13:36'! icon ^ #inspectItIcon! ! !LBCmdInspect methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:06'! label ^ 'Inspect'! ! !LBCmdProvider methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:06'! cluster ^ #'Language Boxes'! ! !LBCmdProvider methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:30'! group ^ #provider! ! !LBCmdProvider methodsFor: 'testing' stamp: 'lr 6/23/2009 11:23'! isActive ^ (requestor isSelected: target) and: [ (target isKindOf: OBClassAwareNode) and: [ target theNonMetaClass includesBehavior: LBLanguageBox ] ]! ! !LBCmdProvider methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:31'! languageBox ^ target theNonMetaClass default! ! LBCmdProvider subclass: #LBCmdRecompile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdRecompile methodsFor: 'execution' stamp: 'lr 6/23/2009 11:48'! execute | environemnt | environemnt := self languageBox recompile. environemnt isEmpty ifFalse: [ environemnt open ]! ! !LBCmdRecompile methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:06'! label ^ 'Recompile'! ! LBCmdProvider subclass: #LBCmdScope instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdScope methodsFor: 'execution' stamp: 'lr 6/23/2009 11:33'! execute self languageBox environment open! ! !LBCmdScope methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:06'! label ^ 'Scope'! ! OBCommand subclass: #LBCmdUser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! LBCmdUser subclass: #LBCmdAdd instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdAdd methodsFor: 'execution' stamp: 'lr 6/23/2009 11:38'! execute | environment box | environment := target browserEnvironment. box := self chooseLanguageBox: 'Add Language Box' select: [ :each | (each environment & environment) isEmpty ]. box isNil ifTrue: [ ^ self ]. box add: environment! ! !LBCmdAdd methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:11'! group ^ #scope! ! !LBCmdAdd methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:06'! label ^ 'Add...'! ! LBCmdUser subclass: #LBCmdBrowse instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdBrowse methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:36'! environment | environment | environment := self languageBoxes inject: ClassEnvironment new into: [ :result :box | (target withinBrowserEnvironment: box environment) ifTrue: [ result addClass: box class ]. result ]. ^ environment label: 'Language Boxes for ' , target name! ! !LBCmdBrowse methodsFor: 'execution' stamp: 'lr 6/23/2009 11:46'! execute | boxes | boxes := self languageBoxes select: [ :each | target withinBrowserEnvironment: each environment ]. boxes isEmpty ifTrue: [ ^ self ]. boxes size = 1 ifTrue: [ ^ requestor browser jumpTo: boxes anyOne class asNode ]. self environment browserInstance open! ! !LBCmdBrowse methodsFor: 'testing' stamp: 'lr 10/30/2008 13:52'! isEnabled ^ self environment isEmpty not! ! !LBCmdBrowse methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:07'! label ^ 'Browse'! ! LBCmdUser subclass: #LBCmdRemove instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBCmdRemove methodsFor: 'execution' stamp: 'lr 6/23/2009 11:38'! execute | environment box | environment := target browserEnvironment. box := self chooseLanguageBox: 'Remove Language Box' select: [ :each | (each environment & environment) isEmpty not ]. box isNil ifTrue: [ ^ self ]. box environments do: [ :each | (each & environment) isEmpty ifFalse: [ box remove: each ] ]! ! !LBCmdRemove methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:11'! group ^ #scope! ! !LBCmdRemove methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:07'! label ^ 'Remove...'! ! !LBCmdUser methodsFor: 'utilities' stamp: 'lr 6/23/2009 11:33'! chooseLanguageBox: aString ^ self chooseLanguageBox: aString select: [ :each | true ]! ! !LBCmdUser methodsFor: 'utilities' stamp: 'lr 11/9/2010 16:58'! chooseLanguageBox: aString select: aBlock | boxes | boxes := self languageBoxes asArray select: aBlock. boxes isEmpty ifTrue: [ ^ nil ]. boxes sort: [ :a :b | a name < b name ]. ^ OBCompletionRequest new prompt: aString; collection: boxes; labelBlock: [ :each | each name = each class name ifTrue: [ each name ] ifFalse: [ each name , ' (' , each class name , ')' ] ]; signal! ! !LBCmdUser methodsFor: 'accessing' stamp: 'lr 9/2/2010 12:06'! cluster ^ #'Language Boxes'! ! !LBCmdUser methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:30'! group ^ #user! ! !LBCmdUser methodsFor: 'testing' stamp: 'lr 10/30/2008 13:43'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OBClassAwareNode ]! ! !LBCmdUser methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:33'! languageBoxes ^ LBLanguageBox all! ! CUCompositeParser subclass: #LBSqlGrammar instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Grammar-SQL'! !LBSqlGrammar commentStamp: 'lr 6/30/2009 11:29' prior: 0! command ::= define_data | modify_data | system_command define_data ::= create_command modify_data ::= select_command | insert_command | update_command | delete_command system_command ::= | describe_command | open_command | close_command | save_command | list_command | clear_command | dump_command | help_command create_command ::= ( "CREATE" | "create" ) (character_set)+ "("((character_set)+,)+")" ("WITH"|"with") ("VALUES"|"values") "("((character_set)+,)+")" select_command ::= ("SELECT"|"select") ("*"|(character_set)+) ("FROM"|"from") (character_set)+ [("WHERE"|"where") condition] [("LIMIT"|"limit") (numeric)+] insert_command ::= ( "INSERT" | "insert" ) ("INTO"|"into") (character_set)+ "("((character_set)+,)+")" ("VALUES"|"values") "("((character_set)+,)+")" update_command ::= ("UPDATE"|update") (character_set)+ ("SET"|"set") (character_set)+ "=" (character_set)+ [("WHERE"|"where") condition] delete_command ::= ("DELETE"|"delete") ("FROM"|"from") (character_set)+ [("WHERE"|"where") condition] open_command ::= ("OPEN"|"open") (character_set)+ close_command ::= ("CLOSE"|"close") (character_set)+ save_command ::= ("SAVE"|"save") | ("SAVE"|"save") ("AS"|"as") (character_set)+ list ::= ("LS"|"ls"|"DIR"|"dir") | ("LS"|"ls"|"DIR"|"dir") (character_set)+ clear ::= ("CLEAR"|"clear"|"CLS"|"cls") dump ::= ("DUMP"|"dump") help ::= ("help"|"HELP"|"/HELP"|"/help"|"/?") condition ::= (character_set)+ (["<"|">"|"!!"]=|["<"|">"|"="]) (character_set)+ [(("AND"|"and")|("OR"|"or")) (character_set)+ (["<"|">"|"!!"]=|["<"|">"|"="]) (character_set)+] character_set ::= "a"|"b"|"c"|"d"|"e"|"f"|"g"|"h"|"i"|"j"|"k"|"l"|"m" "n"|"o"|"p"|"q"|"r"|"s"|"t"|"u"|"v"|"w"|"x"|"y"|"z" |"A"|"B"|"C"|"D"|"E"|"F"|"G"|"H"|"I"|"J"|"K"|"L"|"M" |"N"|"O"|"P"|"Q"|"R"|"S"|"T"|"U"|"V"|"W"|"X"|"Y"|"Z" |"0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9" |"-"|"_"|"("|")"|"."|","|"""|"/"|"\"|"@"|"#"|"~"|"|" |"*"|"&"|"%"|"$"|"灰派"|"!!"|"+"|"?"|">"|"<"|"=" numeric ::= "0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9" ! LBSqlGrammar subclass: #LBSqlCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Grammar-SQL'! !LBSqlCompiler class methodsFor: 'accessing' stamp: 'lr 6/30/2009 13:56'! concern ^ #compile:! ! !LBSqlGrammar methodsFor: 'commands' stamp: 'lr 6/30/2009 11:46'! command createCommand / deleteCommand / insertCommand / selectCommand / updateCommand! ! !LBSqlGrammar methodsFor: 'operators' stamp: 'lr 6/30/2009 12:20'! comparison expression , operator , expression! ! !LBSqlGrammar methodsFor: 'operators' stamp: 'lr 6/30/2009 12:20'! condition comparison separatedBy: logic! ! !LBSqlGrammar methodsFor: 'commands' stamp: 'lr 5/4/2010 14:10'! createCommand 'CREATE' token trim , expression , $( token trim , sequence , $) token trim , 'WITH' token trim , 'VALUES' token trim , $( token trim , sequence , $) token trim! ! !LBSqlGrammar methodsFor: 'commands' stamp: 'lr 5/4/2010 14:10'! deleteCommand 'DELETE' token trim , 'FROM' token trim , expression , whereClause optional! ! !LBSqlGrammar methodsFor: 'operators' stamp: 'lr 6/30/2009 12:27'! expression identifier / number / string! ! !LBSqlGrammar methodsFor: 'tokens' stamp: 'lr 5/4/2010 14:11'! identifier #letter plus token trim! ! !LBSqlGrammar methodsFor: 'commands' stamp: 'lr 5/4/2010 14:10'! insertCommand 'INSERT' token trim , 'INTO' token trim , expression , $( token trim , sequence , $) token trim , 'VALUES' token trim , $( token trim , sequence , $) token trim! ! !LBSqlGrammar methodsFor: 'clauses' stamp: 'lr 5/4/2010 14:10'! limitClause 'LIMIT' token trim , number! ! !LBSqlGrammar methodsFor: 'tokens' stamp: 'lr 5/4/2010 14:11'! logic ('AND' / 'OR') token trim! ! !LBSqlGrammar methodsFor: 'tokens' stamp: 'lr 5/4/2010 14:11'! number #digit plus token trim! ! !LBSqlGrammar methodsFor: 'tokens' stamp: 'lr 5/4/2010 14:11'! operator ('<=' / '>=' / '!!=' / '<' / '>' / '=') token trim! ! !LBSqlGrammar methodsFor: 'clauses' stamp: 'lr 11/9/2010 17:51'! orderClause 'ORDER' token trim , 'BY' token trim , (identifier separatedBy: $, token trim)! ! !LBSqlGrammar methodsFor: 'commands' stamp: 'lr 11/9/2010 17:51'! selectCommand 'SELECT' token trim , ($* token trim / sequence) , 'FROM' token trim , sequence , whereClause optional , orderClause optional , limitClause optional! ! !LBSqlGrammar methodsFor: 'tokens' stamp: 'lr 5/4/2010 14:11'! sequence expression separatedBy: $, token trim! ! !LBSqlGrammar methodsFor: 'accessing' stamp: 'lr 7/1/2009 09:54'! start command! ! !LBSqlGrammar methodsFor: 'tokens' stamp: 'lr 5/4/2010 14:11'! string ($" , $" negate star , $") token trim! ! !LBSqlGrammar methodsFor: 'private' stamp: 'lr 5/4/2010 14:09'! tokenParser ^ LBSqlTokenParser! ! !LBSqlGrammar methodsFor: 'commands' stamp: 'lr 5/4/2010 14:11'! updateCommand 'UPDATE' token trim , expression , 'SET' token trim , expression , $= token trim , expression , whereClause optional! ! !LBSqlGrammar methodsFor: 'clauses' stamp: 'lr 5/4/2010 14:10'! whereClause 'WHERE' token trim , condition! ! LBSqlGrammar subclass: #LBSqlHighlighter instanceVariableNames: '' classVariableNames: 'IdentifierLiteral KeywordToken LogicToken NumberLiteral OperatorToken StringLiteral' poolDictionaries: '' category: 'LanguageBoxes-Grammar-SQL'! !LBSqlHighlighter class methodsFor: 'accessing' stamp: 'lr 6/30/2009 13:56'! concern ^ #highlight:! ! !LBSqlHighlighter class methodsFor: 'initialization' stamp: 'lr 6/30/2009 14:12'! initialize KeywordToken := Array with: TextEmphasis bold with: Color cyan muchDarker. LogicToken := KeywordToken. OperatorToken := Color black. IdentifierLiteral := Color blue muchDarker. NumberLiteral := Color magenta muchDarker. StringLiteral := Color magenta muchDarker! ! !LBSqlHighlighter methodsFor: 'commands' stamp: 'lr 6/30/2009 13:46'! command super command ==> [ :nodes | self highlightKeywords: nodes ]! ! !LBSqlHighlighter methodsFor: 'utilities' stamp: 'lr 6/30/2009 13:49'! highlightKeywords: aCollection ^ aCollection flatten collect: [ :each | (each class = PPToken and: [ each size > 1 ]) ifTrue: [ each -> KeywordToken ] ifFalse: [ each ] ]! ! !LBSqlHighlighter methodsFor: 'tokens' stamp: 'lr 6/30/2009 13:46'! identifier super identifier ==> [ :token | token -> IdentifierLiteral ]! ! !LBSqlHighlighter methodsFor: 'tokens' stamp: 'lr 6/30/2009 13:46'! logic super logic ==> [ :token | token -> LogicToken ]! ! !LBSqlHighlighter methodsFor: 'tokens' stamp: 'lr 6/30/2009 13:46'! number super number ==> [ :token | token -> NumberLiteral ]! ! !LBSqlHighlighter methodsFor: 'tokens' stamp: 'lr 6/30/2009 13:46'! operator super operator ==> [ :token | token -> OperatorToken ]! ! !LBSqlHighlighter methodsFor: 'tokens' stamp: 'lr 6/30/2009 13:46'! string super string ==> [ :token | token -> StringLiteral ]! ! !QQQuoteNode class methodsFor: '*languageboxes' stamp: 'lr 4/6/2009 10:37'! highlight: aCollection ^ CHHighlighter mark: aCollection with: (CHHighlightAttribute new color: (Color black alpha: 0.1); outline: 2; yourself)! ! !CompiledMethod methodsFor: '*languageboxes' stamp: 'lr 10/30/2008 15:11'! isBroken ^ false! ! !QQMetaNode class methodsFor: '*languageboxes' stamp: 'lr 2/3/2009 18:49'! highlight: aCollection ^ aCollection! ! CHRule subclass: #LBHighlightAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Helvetia'! !LBHighlightAction methodsFor: 'visiting' stamp: 'lr 10/15/2010 12:00'! acceptDsl: aVisitor | parser offset tokens | parser := self highlighterClass new. LBLanguageBox activeFor: aVisitor do: [ :box | box modify: parser ]. aVisitor text removeAttributesFrom: aVisitor scopeStart to: aVisitor scopeStop. offset := aVisitor scopeStart - 1. tokens :=aVisitor isDoIt ifTrue: [ parser parseExpression: aVisitor scopedText readStream onError: [ :msg :pos | #() ] ] ifFalse: [ parser parseMethod: aVisitor scopedText readStream onError: [ :msg :pos | #() ] ]. tokens flattenedDo: [ :each | (each isVariableBinding and: [ each key isKindOf: PPToken ]) ifTrue: [ aVisitor scopeFrom: offset + each key start to: offset + each key stop with: nil visit: each value. each key comments do: [ :interval | aVisitor scopeFrom: offset + interval first to: offset + interval last with: nil visit: (LBSmalltalkHighlighter classPool at: #CommentColor) ] ]. (each isKindOf: PPToken) ifTrue: [ each comments do: [ :interval | aVisitor scopeFrom: offset + interval first to: offset + interval last with: nil visit: (LBSmalltalkHighlighter classPool at: #CommentColor) ] ] ]! ! !LBHighlightAction methodsFor: 'accessing' stamp: 'lr 9/2/2010 19:13'! highlighterClass ^ LBSmalltalkHighlighter! ! CHRule subclass: #LBParseAction instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Helvetia'! !LBParseAction methodsFor: 'visiting' stamp: 'lr 9/2/2010 15:49'! acceptDsl: aVisitor | parser | parser := self parserClass new. LBLanguageBox activeFor: aVisitor do: [ :box | box modify: parser ]. ^ aVisitor isDoIt ifTrue: [ parser parseExpression: aVisitor stream onError: [ :msg :pos | CHParserError signal: msg at: pos ] ] ifFalse: [ parser parseMethod: aVisitor stream onError: [ :msg :pos | CHParserError signal: msg at: pos ] ]! ! !LBParseAction methodsFor: 'accessing' stamp: 'lr 9/11/2010 11:37'! parserClass ^ PPSmalltalkParser! ! !PPToken methodsFor: '*languageboxes' stamp: 'lr 10/15/2010 11:57'! comments ^ #()! ! PPTokenParser subclass: #LBSqlTokenParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Grammar-SQL'! !LBSqlTokenParser methodsFor: 'parsing' stamp: 'lr 5/4/2010 14:08'! parse: aStream | start element stop | self consumeSpacesBefore: aStream. start := aStream position. element := parser class = PPLiteralSequenceParser ifFalse: [ super parse: aStream ] ifTrue: [ | input | input := aStream next: parser string size. (input sameAs: parser string) ifTrue: [ input ] ifFalse: [ PPFailure reason: parser string , ' expected' at: start ] ]. element isPetitFailure ifTrue: [ ^ element ]. stop := aStream position. self consumeSpacesAfter: aStream. ^ self create: aStream collection start: start + 1 stop: stop! ! PPSmalltalkGrammar subclass: #LBSmalltalkHighlighter instanceVariableNames: '' classVariableNames: 'ArrayLiteral AssignmentToken BlockBrackets ByteLiteral CharLiteral CommentColor ExpressionBrackets FalseLiteral GlobalVariableTag MethodTag NilLiteral NumberLiteral PragmaTag ReturnTag SelfVariable StringLiteral SuperVariable SymbolLiteral TempToken ThisContextVariable TrueLiteral VariableTag' poolDictionaries: '' category: 'LanguageBoxes-Grammar-Smalltalk'! !LBSmalltalkHighlighter class methodsFor: 'accessing' stamp: 'lr 1/19/2009 09:30'! concern ^ #highlight:! ! !LBSmalltalkHighlighter class methodsFor: 'initialization' stamp: 'lr 1/30/2009 15:48'! initialize MethodTag := TextEmphasis bold. PragmaTag := Color gray muchDarker. ReturnTag := TextEmphasis bold. VariableTag := Color blue muchDarker. GlobalVariableTag := Color blue muchDarker. SelfVariable := Color cyan muchDarker. SuperVariable := Color cyan muchDarker. ThisContextVariable := Color cyan muchDarker. NilLiteral := Color cyan muchDarker. FalseLiteral := Color cyan muchDarker. TrueLiteral := Color cyan muchDarker. CharLiteral := Color magenta muchDarker. StringLiteral := Color magenta muchDarker. SymbolLiteral := Color magenta muchDarker. NumberLiteral := Color magenta muchDarker. ArrayLiteral := Color magenta muchDarker. ByteLiteral := Color magenta muchDarker. TempToken := nil. BlockBrackets := nil. AssignmentToken := nil. ExpressionBrackets := nil. CommentColor := Color green muchDarker! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:22'! arrayLiteral ^ super arrayLiteral ==> [ :token | token at: 1 put: token first -> ArrayLiteral; at: token size put: token last -> ArrayLiteral; yourself ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:22'! arrayLiteralArray ^ super arrayLiteralArray ==> [ :token | token at: 1 put: token first -> ArrayLiteral; at: token size put: token last -> ArrayLiteral; yourself ].! ! !LBSmalltalkHighlighter methodsFor: 'token' stamp: 'lr 9/2/2010 19:25'! assignmentToken ^ super assignmentToken ==> [ :token | token -> AssignmentToken ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-blocks' stamp: 'lr 9/2/2010 19:18'! block ^ super block ==> [ :token | token at: 1 put: token first -> BlockBrackets; at: token size put: token last -> BlockBrackets; yourself ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-blocks' stamp: 'lr 10/15/2010 11:49'! blockBody ^ super blockBody ==> [ :nodes | nodes first last isNil ifFalse: [ nodes first at: nodes first size put: nodes first last -> BlockBrackets ]. nodes ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! byteLiteral ^ super byteLiteral ==> [ :token | token at: 1 put: token first -> ByteLiteral; at: token size put: token last -> ByteLiteral; yourself ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:23'! byteLiteralArray ^ super byteLiteralArray ==> [ :token | token at: 1 put: token first -> ByteLiteral; at: token size put: token last -> ByteLiteral; yourself ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! charLiteral ^ super charLiteral ==> [ :token | token -> CharLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! falseLiteral ^ super falseLiteral ==> [ :token | token -> FalseLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'private' stamp: 'lr 4/2/2009 15:32'! mark: aCollection with: anObject ^ CHHighlighter mark: aCollection with: anObject! ! !LBSmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 9/2/2010 19:17'! methodDeclaration ^ super methodDeclaration ==> [ :nodes | self mark: nodes with: MethodTag ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! nilLiteral ^ super nilLiteral ==> [ :token | token -> NilLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! numberLiteral ^ super numberLiteral ==> [ :token | token -> NumberLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 9/2/2010 19:18'! parens ^ super parens ==> [ :token | token at: 1 put: token first -> ExpressionBrackets; at: token size put: token last -> ExpressionBrackets; yourself ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 9/2/2010 19:18'! pragma ^ super pragma ==> [ :nodes | self mark: nodes with: PragmaTag ] ! ! !LBSmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 9/2/2010 19:18'! return ^ super return ==> [ :nodes | nodes at: 1 put: nodes first -> ReturnTag; yourself ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! stringLiteral ^ super stringLiteral ==> [ :token | token -> StringLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! symbolLiteral ^ super symbolLiteral ==> [ :token | token -> SymbolLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:25'! symbolLiteralArray ^ super symbolLiteralArray ==> [ :token | token -> SymbolLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 9/2/2010 19:18'! temporaries ^ super temporaries ==> [ :nodes | nodes isEmpty ifFalse: [ nodes at: 1 put: nodes first -> TempToken; at: nodes size put: nodes last -> TempToken ]. nodes ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar-literals' stamp: 'lr 9/2/2010 19:24'! trueLiteral ^ super trueLiteral ==> [ :token | token -> TrueLiteral ]! ! !LBSmalltalkHighlighter methodsFor: 'grammar' stamp: 'lr 9/2/2010 19:18'! variable ^ super variable ==> [ :token | token value = 'self' ifTrue: [ token -> SelfVariable ] ifFalse: [ token value = 'super' ifTrue: [ token -> SuperVariable ] ifFalse: [ token value = 'thisContext' ifTrue: [ token -> ThisContextVariable ] ifFalse: [ (Smalltalk hasClassNamed: token value) ifTrue: [ token -> GlobalVariableTag ] ifFalse: [ token -> VariableTag ] ] ] ] ]! ! !QQUnquoteNode class methodsFor: '*languageboxes' stamp: 'lr 4/6/2009 10:38'! highlight: aCollection ^ CHHighlighter mark: aCollection with: (CHHighlightAttribute new borderColor: Color darkGray; borderWidth: 1; yourself)! ! !Collection methodsFor: '*languageboxes' stamp: 'lr 9/2/2010 16:01'! flatten ^ Array streamContents: [ :stream | self flattenedDo: [ :each | stream nextPut: each ] ]! ! !Collection methodsFor: '*languageboxes' stamp: 'lr 9/2/2010 16:02'! flattenedDo: aBlock self do: [ :each | (each isCollection and: [ each isString not ]) ifTrue: [ each flattenedDo: aBlock ] ifFalse: [ aBlock value: each ] ]! ! !OBCodeBrowser methodsFor: '*languageboxes' stamp: 'lr 11/9/2010 12:46'! languageBoxProviderCommands ^ LBCmdProvider allSubclasses! ! !OBCodeBrowser methodsFor: '*languageboxes' stamp: 'lr 11/9/2010 12:46'! languageBoxUserCommands ^ LBCmdUser allSubclasses! ! OBFilter subclass: #LBBrokenMethodFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-OmniBrowser'! !LBBrokenMethodFilter methodsFor: 'filtering' stamp: 'lr 9/12/2010 10:40'! displayString: aString forNode: aNode ^ (aNode isMethodNode and: [ (aNode theClass compiledMethodAt: aNode selector) isBroken ]) ifTrue: [ aString asText addAttribute: TextColor red ] ifFalse: [ aString ]! ! !PPParser methodsFor: '*languageboxes' stamp: 'lr 7/11/2011 12:01'! javaToken ^ self token trim: LBJavaCommentGrammar new! ! !PPSmalltalkParser class methodsFor: '*languageboxes' stamp: 'lr 9/11/2010 11:38'! concern ^ #compile:! ! !QQSpliceNode class methodsFor: '*languageboxes' stamp: 'lr 4/6/2009 10:21'! highlight: aCollection ^ CHHighlighter mark: aCollection with: Color darkGray! ! !OBMetagraphBuilder methodsFor: '*languageboxes-core' stamp: 'lr 9/12/2010 10:42'! populateBrokenMethod self methodMetaNode addFilter: LBBrokenMethodFilter new! ! PPCompositeParser subclass: #LBXmlGrammar instanceVariableNames: 'comment whitespace nameStartChar nameChar nameToken element attributes content characterData attribute attributeValue equalsToken elementEmpty elementFilled openToken slashToken closeToken attributeKey elementName' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Grammar-XML'! LBXmlGrammar subclass: #LBXmlCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Grammar-XML'! !LBXmlCompiler class methodsFor: 'accessing' stamp: 'lr 11/29/2010 12:49'! concern ^ #compile:! ! !LBXmlCompiler methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:34'! attribute ^ super attribute ==> [ :nodes | PPXmlAttribute name: (PPXmlName name: nodes first value) value: nodes last value ]! ! !LBXmlCompiler methodsFor: 'grammar' stamp: 'lr 11/29/2010 13:58'! attributes ^ super attributes ==> [ :nodes | nodes inject: OrderedCollection new into: [ :result :each | result addLast: each; yourself ] ]! ! !LBXmlCompiler methodsFor: 'grammar-character' stamp: 'lr 11/29/2010 13:58'! characterData ^ super characterData ==> [ :nodes | PPXmlText data: nodes ]! ! !LBXmlCompiler methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:20'! comment "[15] Comment ::= ''" ^ super comment ==> [ :token | PPXmlComment data: (token value copyFrom: 4 to: token size - 3) ]! ! !LBXmlCompiler methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:36'! elementEmpty ^ super elementEmpty ==> [ :nodes | PPXmlElement name: (PPXmlName name: nodes second value) attributes: nodes third children: #() ]! ! !LBXmlCompiler methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:36'! elementFilled ^ super elementFilled ==> [ :nodes | PPXmlElement name: (PPXmlName name: nodes second value) attributes: nodes third children: nodes sixth ]! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:26'! attribute "[41] Attribute ::= Name Eq AttValue" ^ attributeKey , whitespace optional , equalsToken , whitespace optional , attributeValue! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:29'! attributeKey ^ nameToken! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 11/29/2010 13:59'! attributeValue "[10] AttValue ::= '""' ([^<&""] | Reference)* '""' | ""'"" ([^<&'] | Reference)* " ^ ($" asParser , $" asParser negate star , $" asParser) token / ($' asParser , $' asParser negate star , $' asParser) token! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 11/29/2010 12:47'! attributes "[40] STag ::= '<' Name (S Attribute)* S? '>' " ^ ((whitespace , attribute) ==> #second) star! ! !LBXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 11/29/2010 12:47'! characterData "[14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)" ^ $< asParser negate plus flatten! ! !LBXmlGrammar methodsFor: 'token' stamp: 'lr 11/29/2010 14:03'! closeToken ^ $> asParser token! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 11/29/2010 12:51'! comment "[15] Comment ::= ''" ^ ('' asParser negate star flatten , '-->' asParser) token! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:18'! content "[43] content ::= CharData? ((element | Reference | CDSect | PI | Comment) CharData?)*" ^ characterData optional , ((element / comment) , characterData optional) star ==> [ :nodes | | result | result := OrderedCollection new. nodes first isNil ifFalse: [ result addLast: nodes first ]. nodes second do: [ :each | result addLast: each first. each second isNil ifFalse: [ result addLast: each second ] ]. result asArray ]! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 11/29/2010 14:01'! element "[39] element ::= EmptyElemTag | STag content ETag" ^ elementEmpty / elementFilled! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:29'! elementEmpty ^ openToken , elementName , attributes , whitespace optional , slashToken , closeToken! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:30'! elementFilled ^ openToken , elementName , attributes , whitespace optional , closeToken , content , openToken , slashToken , elementName , whitespace optional , closeToken! ! !LBXmlGrammar methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:30'! elementName ^ nameToken! ! !LBXmlGrammar methodsFor: 'token' stamp: 'lr 11/29/2010 13:59'! equalsToken ^ $= asParser token! ! !LBXmlGrammar methodsFor: 'token-characters' stamp: 'lr 11/29/2010 12:47'! nameChar "[4a] NameChar ::= NameStartChar | ""-"" | ""."" | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]" ^ PPPredicateObjectParser on: (PPCharSetPredicate on: [ :char | char = $- or: [ char = $. or: [ char = $: or: [ char = $_ or: [ char isAlphaNumeric ] ] ] ] ]) message: 'name expected'! ! !LBXmlGrammar methodsFor: 'token-characters' stamp: 'lr 11/29/2010 12:47'! nameStartChar "[4] NameStartChar ::= "":"" | [A-Z] | ""_"" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]" ^ PPPredicateObjectParser on: (PPCharSetPredicate on: [ :char | char = $: or: [ char = $_ or: [ char isLetter ] ] ]) message: 'name expected'! ! !LBXmlGrammar methodsFor: 'token' stamp: 'lr 11/29/2010 13:59'! nameToken "[5] Name ::= NameStartChar (NameChar)*" ^ (nameStartChar , nameChar star) token! ! !LBXmlGrammar methodsFor: 'token' stamp: 'lr 11/29/2010 14:03'! openToken ^ $< asParser token! ! !LBXmlGrammar methodsFor: 'token' stamp: 'lr 11/29/2010 14:03'! slashToken ^ $/ asParser token! ! !LBXmlGrammar methodsFor: 'accessing' stamp: 'lr 12/13/2010 15:14'! start ^ element! ! !LBXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 11/29/2010 12:47'! whitespace "[3] S ::= (#x20 | #x9 | #xD | #xA)+" ^ #space asParser plus! ! LBXmlGrammar subclass: #LBXmlHighlighter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Grammar-XML'! !LBXmlHighlighter class methodsFor: 'accessing' stamp: 'lr 11/29/2010 12:39'! concern ^ #highlight:! ! !LBXmlHighlighter methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:27'! attributeKey ^ super attributeKey ==> [ :token | token -> TextColor blue ]! ! !LBXmlHighlighter methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:25'! attributeValue ^ super attributeValue ==> [ :token | token -> TextColor magenta ]! ! !LBXmlHighlighter methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:28'! comment ^ super comment ==> [ :token | token -> (Color r: 0 g: 0.5 b: 0) ]! ! !LBXmlHighlighter methodsFor: 'grammar' stamp: 'lr 12/13/2010 15:31'! elementName ^ super elementName ==> [ :token | token -> (Array with: Color blue with: TextEmphasis bold) ]! ! Object subclass: #LBBrokenMethod instanceVariableNames: 'theClass selector source' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Core'! !LBBrokenMethod class methodsFor: 'instance creation' stamp: 'lr 10/30/2008 14:42'! class: aClass selector: aSelector source: aString ^ self new initializeClass: aClass selector: aSelector source: aString! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:53'! compiledMethod ^ self! ! !LBBrokenMethod methodsFor: 'source' stamp: 'lr 10/30/2008 14:48'! flushCache! ! !LBBrokenMethod methodsFor: 'source' stamp: 'lr 10/30/2008 14:38'! getSource ^ source! ! !LBBrokenMethod methodsFor: 'source' stamp: 'lr 10/30/2008 14:49'! getSourceFor: aSelector in: aClass ^ source! ! !LBBrokenMethod methodsFor: 'source' stamp: 'lr 10/30/2008 15:07'! getSourceFromFile ^ source! ! !LBBrokenMethod methodsFor: 'literals' stamp: 'lr 10/30/2008 14:37'! hasLiteral: anObject ^ false! ! !LBBrokenMethod methodsFor: 'initialization' stamp: 'lr 10/30/2008 14:28'! initializeClass: aClass selector: aSelector source: aString theClass := aClass. selector := aSelector. source := aString! ! !LBBrokenMethod methodsFor: 'testing' stamp: 'lr 10/30/2008 15:08'! isBroken ^ true! ! !LBBrokenMethod methodsFor: 'testing' stamp: 'lr 10/30/2008 14:55'! isRequired ^ false! ! !LBBrokenMethod methodsFor: 'testing' stamp: 'lr 10/30/2008 14:53'! isSubclassResponsibility ^ false! ! !LBBrokenMethod methodsFor: 'literals' stamp: 'lr 10/30/2008 14:36'! literals ^ #()! ! !LBBrokenMethod methodsFor: 'literals' stamp: 'lr 9/12/2010 10:37'! literalsDo: aBlock self literals do: aBlock! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:38'! methodClass ^ theClass! ! !LBBrokenMethod methodsFor: 'protocol' stamp: 'lr 10/30/2008 15:13'! methodClass: aClass! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:35'! pragmas ^ #()! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 9/2/2010 11:57'! properties ^ AdditionalMethodState forMethod: self selector: self selector! ! !LBBrokenMethod methodsFor: 'evaluating' stamp: 'lr 10/30/2008 14:26'! run: aSelector with: anArray in: anObject self error: 'Unable to compile ' , aSelector printString! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:38'! selector ^ selector! ! !LBBrokenMethod methodsFor: 'protocol' stamp: 'lr 10/30/2008 15:13'! selector: aSelector! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:53'! sendsToSuper ^ false! ! !LBBrokenMethod methodsFor: 'source' stamp: 'lr 10/30/2008 15:16'! sourcePointer ^ 0! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 10/30/2008 14:57'! timeStamp ^ nil! ! !LBBrokenMethod methodsFor: 'accessing' stamp: 'lr 9/2/2010 11:58'! trailer ^ CompiledMethodTrailer empty! ! Object subclass: #LBChange instanceVariableNames: 'fragment production action class' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Core'! !LBChange methodsFor: 'operators' stamp: 'lr 6/23/2009 11:22'! , anAdvice ^ LBChangeSequence new , self , anAdvice! ! !LBChange methodsFor: 'accessing' stamp: 'lr 1/19/2009 09:57'! action: aSymbol "The action to apply." action := aSymbol asSymbol! ! !LBChange methodsFor: 'accessing-place' stamp: 'lr 6/23/2009 11:27'! after: aGrammar "Insert the new grammar after the rule aGrammar." self action: #after. self production: aGrammar! ! !LBChange methodsFor: 'accessing-place' stamp: 'lr 6/23/2009 11:27'! before: aGrammar "Insert the new grammar before the rule aGrammar." self action: #before. self production: aGrammar! ! !LBChange methodsFor: 'accessing-list' stamp: 'lr 10/10/2008 15:39'! choice "Use a choice to combine the two grammars." class := PPChoiceParser! ! !LBChange methodsFor: 'accessing' stamp: 'lr 6/30/2009 14:42'! fragment: aGrammar "The grammar fragment to introduce." fragment := aGrammar asParser! ! !LBChange methodsFor: 'initialization' stamp: 'lr 6/30/2009 14:43'! initialize self choice; after: PPEpsilonParser new. self fragment: (PPFailingParser message: 'Invalid Parser')! ! !LBChange methodsFor: 'public' stamp: 'lr 6/30/2009 15:29'! modify: aGrammar with: aBox | copied wrapped | copied := production copy. wrapped := aBox isNil ifTrue: [ fragment ] ifFalse: [ fragment ==> [ :nodes | aBox perform: aGrammar class concern with: (aBox transform: nodes) ] ]. production def: (action = #replace ifTrue: [ wrapped ] ifFalse: [ action = #before ifTrue: [ class with: wrapped with: copied ] ifFalse: [ action = #after ifTrue: [ class with: copied with: wrapped ] ifFalse: [ self error: 'Invalid change action.' ] ] ])! ! !LBChange methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:26'! production: aGrammar "The production to change." production := aGrammar asParser! ! !LBChange methodsFor: 'accessing-place' stamp: 'lr 6/23/2009 11:27'! replace: aGrammar "Replace the aGrammar." self action: #replace. self production: aGrammar! ! !LBChange methodsFor: 'accessing-list' stamp: 'lr 1/19/2009 09:38'! sequence "Use a sequence to combine the two grammars." class := PPSequenceParser! ! Object subclass: #LBChangeSequence instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Core'! !LBChangeSequence methodsFor: 'operators' stamp: 'lr 6/23/2009 11:20'! , aChange changes add: aChange! ! !LBChangeSequence methodsFor: 'initialization' stamp: 'lr 6/23/2009 11:20'! initialize super initialize. changes := OrderedCollection new! ! !LBChangeSequence methodsFor: 'public' stamp: 'lr 6/23/2009 11:21'! modify: aGrammar with: aBox changes do: [ :change | change modify: aGrammar with: aBox ]! ! Object subclass: #LBLanguageBox instanceVariableNames: 'active environments' classVariableNames: '' poolDictionaries: '' category: 'LanguageBoxes-Core'! LBLanguageBox class instanceVariableNames: 'default'! LBLanguageBox class instanceVariableNames: 'default'! !LBLanguageBox class methodsFor: 'querying' stamp: 'lr 6/23/2009 12:08'! activeFor: aContext do: aBlock self all do: [ :box | (box isActiveFor: aContext) ifTrue: [ aBlock value: box ] ]! ! !LBLanguageBox class methodsFor: 'accessing' stamp: 'lr 9/11/2010 11:42'! all "Answer all language boxes of the system." ^ (self allSubclasses reject: [ :each | each isAbstract ]) collect: [ :each | each default ]! ! !LBLanguageBox class methodsFor: 'accessing' stamp: 'lr 6/23/2009 11:24'! default "Answer the langauage box instance of the receiver." ^ default ifNil: [ default := self new ]! ! !LBLanguageBox class methodsFor: 'querying' stamp: 'lr 9/11/2010 11:41'! isAbstract ^ self name = #LBLanguageBox! ! !LBLanguageBox class methodsFor: 'instance creation' stamp: 'lr 9/11/2010 11:43'! new self isAbstract ifTrue: [ self error: 'Abstract language boxes cannot be instantiated.' ]. ^ super new! ! !LBLanguageBox class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:30'! recompile self all do: [ :each | each recompile ]! ! !LBLanguageBox class methodsFor: 'initialization' stamp: 'lr 10/28/2008 15:30'! unload self all do: [ :each | each disable ]! ! !LBLanguageBox methodsFor: 'private' stamp: 'lr 6/23/2009 11:24'! active: aBoolean "Enable or disable the receiving language box." active = aBoolean ifTrue: [ ^ self ]. active := aBoolean. self recompile! ! !LBLanguageBox methodsFor: 'scoping' stamp: 'lr 6/23/2009 11:24'! add: anEnvironment "Add anEnvironment to the receiving language box and incrementally update all code." environments := environments copyWith: anEnvironment. self isActive ifTrue: [ self recompile: anEnvironment ]. ^ anEnvironment! ! !LBLanguageBox methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:10'! addClass: aClass ^ self add: (BrowserEnvironment new forClasses: (Array with: aClass))! ! !LBLanguageBox methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:10'! addPackage: aString ^ self add: (BrowserEnvironment new forPackageNamed: aString)! ! !LBLanguageBox methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:10'! addPragma: aKeyword ^ self add: (BrowserEnvironment new forPragmas: (Array with: aKeyword))! ! !LBLanguageBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:03'! change: aGrammar "A hook method that that answers an change on how to modify the language. aGrammar is the original language model and might be used to reference existing grammar productions." self subclassResponsibility! ! !LBLanguageBox methodsFor: 'hooks' stamp: 'lr 6/30/2009 14:03'! compile: aCollection "A hook method that that transforms a collection of token to the AST." ^ aCollection lift! ! !LBLanguageBox methodsFor: 'actions' stamp: 'lr 6/23/2009 11:25'! disable "Disable the receiving langauge box." self active: false! ! !LBLanguageBox methodsFor: 'actions' stamp: 'lr 6/23/2009 11:25'! enable "Enable the receiving language box." self active: true! ! !LBLanguageBox methodsFor: 'accessing' stamp: 'lr 11/11/2008 16:10'! environment "Answer the users of environment of the receiver." | environment | environment := self environments inject: BrowserEnvironment new not into: [ :result :each | result | each ]. environment label: 'Users of ' , self name. ^ environment! ! !LBLanguageBox methodsFor: 'accessing' stamp: 'lr 10/28/2008 15:24'! environments "Answer the environments of the receiver." ^ environments! ! !LBLanguageBox methodsFor: 'hooks' stamp: 'lr 1/19/2009 09:27'! highlight: aCollection "A hook method that that highlights a collection of token to the AST, by default do not highlight anything." ^ aCollection! ! !LBLanguageBox methodsFor: 'testing' stamp: 'lr 6/23/2009 11:25'! includesSelector: aSelector in: aClass "Answer whether the receiving language box is active in the given context or not." ^ self environments anySatisfy: [ :each | each includesSelector: aSelector in: aClass ]! ! !LBLanguageBox methodsFor: 'initialization' stamp: 'lr 11/6/2008 14:09'! initialize active := true. environments := #()! ! !LBLanguageBox methodsFor: 'testing' stamp: 'lr 6/23/2009 11:25'! isActive "Answer wether the receiving language box is active or not." ^ active! ! !LBLanguageBox methodsFor: 'testing' stamp: 'lr 6/23/2009 11:25'! isActiveFor: aContext "Answer whether the receiving language box is active for the given context." ^ self isActive and: [ self includesSelector: aContext selector in: aContext theClass ]! ! !LBLanguageBox methodsFor: 'public' stamp: 'lr 6/23/2009 11:17'! modify: aGrammar "Modify a grammar by applying a change object to it." (self change: aGrammar) modify: aGrammar with: self! ! !LBLanguageBox methodsFor: 'accessing' stamp: 'lr 10/2/2009 14:48'! name "A human readable name of the language box." ^ self class name! ! !LBLanguageBox methodsFor: 'actions' stamp: 'lr 6/23/2009 12:04'! recompile "Recompile all the affected methods in the selected enviornments." | environment | environment := SelectorEnvironment new. self environments do: [ :each | (self recompile: each) classesAndSelectorsDo: [ :class :selector | environment addClass: class selector: selector ] ]. ^ environment label: 'Broken methods'! ! !LBLanguageBox methodsFor: 'actions' stamp: 'lr 9/12/2010 10:24'! recompile: anEnvironment "Recompile all the affected methods in anEnvironment." | environment | environment := SelectorEnvironment new. environment label: 'Broken methods'. anEnvironment classesAndSelectorsDo: [ :class :selector | [ self recompileClass: class selector: selector ] on: CHParserError do: [ :err | class methodDictionary at: selector ifPresent: [ :method | environment addClass: class selector: selector. class methodDictAddSelectorSilently: selector withMethod: (LBBrokenMethod class: class selector: selector source: method getSource) ] ] ]. ^ environment! ! !LBLanguageBox methodsFor: 'private' stamp: 'lr 10/30/2008 15:14'! recompileClass: aClass selector: aSelector | method | method := aClass methodDictionary at: aSelector ifAbsent: [ ^ self ]. method isBroken ifTrue: [ aClass compile: method getSource ] ifFalse: [ aClass recompile: aSelector ]! ! !LBLanguageBox methodsFor: 'scoping' stamp: 'lr 10/28/2008 15:25'! remove: anEnvironment "Removes anEnvironment from the scope of the receiver and incrementally update all code." environments := environments copyWithout: anEnvironment. self isActive ifTrue: [ self recompile: anEnvironment ]. ^ anEnvironment! ! !LBLanguageBox methodsFor: 'hooks' stamp: 'lr 3/9/2009 17:41'! transform: aToken "A hook method that that is always called with the parse result of the parse tree advice." ^ aToken! ! LBSqlHighlighter initialize! LBSmalltalkHighlighter initialize!