2008-09-10 23:11:40 -04:00
|
|
|
! Copyright (C) 2007, 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-12-17 19:10:01 -05:00
|
|
|
USING: xmode.marker.context xmode.rules accessors
|
2008-09-10 23:11:40 -04:00
|
|
|
xmode.tokens namespaces make kernel sequences assocs math ;
|
2007-11-28 23:34:11 -05:00
|
|
|
IN: xmode.marker.state
|
|
|
|
|
|
|
|
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
|
|
|
|
2008-03-07 22:24:50 -05:00
|
|
|
SYMBOLS: line last-offset position context
|
|
|
|
whitespace-end seen-whitespace-end?
|
|
|
|
escaped? process-escape? delegate-end-escaped? ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: current-rule ( -- rule )
|
2008-08-30 21:32:26 -04:00
|
|
|
context get in-rule>> ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: current-rule-set ( -- rule )
|
2008-08-30 21:32:26 -04:00
|
|
|
context get in-rule-set>> ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: current-keywords ( -- keyword-map )
|
2008-08-30 22:10:02 -04:00
|
|
|
current-rule-set keywords>> ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: token, ( from to id -- )
|
2008-12-17 20:17:37 -05:00
|
|
|
2over = [ 3drop ] [ [ line get subseq ] dip <token> , ] if ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: prev-token, ( id -- )
|
2008-12-17 20:17:37 -05:00
|
|
|
[ last-offset get position get ] dip token,
|
2007-11-28 23:34:11 -05:00
|
|
|
position get last-offset set ;
|
|
|
|
|
|
|
|
: next-token, ( len id -- )
|
2008-12-17 20:17:37 -05:00
|
|
|
[ position get 2dup + ] dip token,
|
2009-08-13 20:21:44 -04:00
|
|
|
position get + dup 1 - position set last-offset set ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: push-context ( rules -- )
|
|
|
|
context [ <line-context> ] change ;
|
|
|
|
|
|
|
|
: pop-context ( -- )
|
2008-08-30 21:32:26 -04:00
|
|
|
context get parent>>
|
|
|
|
f >>in-rule context set ;
|
2007-11-28 23:34:11 -05:00
|
|
|
|
2007-12-10 02:20:36 -05:00
|
|
|
: init-token-marker ( main prev-context line -- )
|
2007-11-28 23:34:11 -05:00
|
|
|
line set
|
2007-12-10 02:20:36 -05:00
|
|
|
[ ] [ f <line-context> ] ?if context set
|
2007-11-28 23:34:11 -05:00
|
|
|
0 position set
|
|
|
|
0 last-offset set
|
|
|
|
0 whitespace-end set
|
2007-12-10 02:20:36 -05:00
|
|
|
process-escape? on ;
|