steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Various fixes

release
Slava Pestov 2007-12-06 00:23:18 -05:00
parent 59566c20e9
commit a969934061
7 changed files with 98 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/xmode/README.txt
View File

@ -32,10 +32,10 @@ to depend on:
it inherits the value of the NO_WORD_SEP attribute from the previous it inherits the value of the NO_WORD_SEP attribute from the previous
RULES tag. RULES tag.
The Factor implementation does not duplicate this behavior. The Factor implementation does not duplicate this behavior. If you
find a mode file which depends on this flaw, please fix it and submit
the changes to the jEdit project.
This is still a work in progress. If you find any behavioral differences If you wish to contribute a new or improved mode file, please contact
between the Factor implementation and the original jEdit code, please the jEdit project. Updated mode files in jEdit will be periodically
report them as bugs. Also, if you wish to contribute a new or improved imported into the Factor source tree.
mode file, please contact the jEdit project. Updated mode files in jEdit
will be periodically imported into the Factor source tree.

40
extra/xmode/code2html/code2html.factor Normal file → Executable file
View File

@ -15,8 +15,10 @@ IN: xmode.code2html
: htmlize-line ( line-context line rules -- line-context' ) : htmlize-line ( line-context line rules -- line-context' )
tokenize-line htmlize-tokens ; tokenize-line htmlize-tokens ;
: htmlize-lines ( lines rules -- ) : htmlize-lines ( lines mode -- )
<pre> f -rot [ htmlize-line nl ] curry each drop </pre> ; <pre>
f swap load-mode [ htmlize-line nl ] curry reduce drop
</pre> ;
: default-stylesheet ( -- ) : default-stylesheet ( -- )
<style> <style>
@ -24,22 +26,20 @@ IN: xmode.code2html
resource-path <file-reader> contents write resource-path <file-reader> contents write
</style> ; </style> ;
: htmlize-stream ( path stream -- )
lines swap
<html>
<head>
default-stylesheet
<title> dup write </title>
</head>
<body>
over empty?
[ 2drop ]
[ over first find-mode htmlize-lines ] if
</body>
</html> ;
: htmlize-file ( path -- ) : htmlize-file ( path -- )
dup <file-reader> lines dup empty? [ 2drop ] [ dup <file-reader> over ".html" append <file-writer>
swap dup ".html" append <file-writer> [ [ htmlize-stream ] with-stream ;
[
<html>
<head>
<title> dup write </title>
default-stylesheet
</head>
<body>
over first
find-mode
load-mode
htmlize-lines
</body>
</html>
] with-html-stream
] with-stream
] if ;

27
extra/xmode/loader/loader.factor
View File

@ -32,10 +32,13 @@ IN: xmode.loader
swap [ at string>boolean ] curry map first3 ; swap [ at string>boolean ] curry map first3 ;
: parse-literal-matcher ( tag -- matcher ) : parse-literal-matcher ( tag -- matcher )
dup children>string swap position-attrs <matcher> ; dup children>string
\ ignore-case? get [ <ignore-case> ] when
swap position-attrs <matcher> ;
: parse-regexp-matcher ( tag -- matcher ) : parse-regexp-matcher ( tag -- matcher )
dup children>string <regexp> swap position-attrs <matcher> ; dup children>string <regexp>
swap position-attrs <matcher> ;
! SPAN's children ! SPAN's children
<TAGS: parse-begin/end-tag <TAGS: parse-begin/end-tag
@ -130,22 +133,25 @@ RULE: MARK_FOLLOWING mark-following-rule
RULE: MARK_PREVIOUS mark-previous-rule RULE: MARK_PREVIOUS mark-previous-rule
shared-tag-attrs match-type-attr literal-start ; shared-tag-attrs match-type-attr literal-start ;
: parse-keyword-tag : parse-keyword-tag ( tag keyword-map -- )
dup name-tag string>token swap children>string rot set-at ; >r dup name-tag string>token swap children>string r> set-at ;
TAG: KEYWORDS ( rule-set tag -- key value ) TAG: KEYWORDS ( rule-set tag -- key value )
>r rule-set-keywords r> \ ignore-case? get <keyword-map>
child-tags [ parse-keyword-tag ] curry* each ; swap child-tags [ over parse-keyword-tag ] each
swap set-rule-set-keywords ;
TAGS> TAGS>
: ?<regexp> dup [ <regexp> ] when ;
: (parse-rules-tag) ( tag -- rule-set ) : (parse-rules-tag) ( tag -- rule-set )
<rule-set> <rule-set>
{ {
{ "SET" string>rule-set-name set-rule-set-name } { "SET" string>rule-set-name set-rule-set-name }
{ "IGNORE_CASE" string>boolean set-rule-set-ignore-case? } { "IGNORE_CASE" string>boolean set-rule-set-ignore-case? }
{ "HIGHLIGHT_DIGITS" string>boolean set-rule-set-highlight-digits? } { "HIGHLIGHT_DIGITS" string>boolean set-rule-set-highlight-digits? }
{ "DIGIT_RE" <regexp> set-rule-set-digit-re } ! XXX { "DIGIT_RE" ?<regexp> set-rule-set-digit-re }
{ "ESCAPE" f add-escape-rule } { "ESCAPE" f add-escape-rule }
{ "DEFAULT" string>token set-rule-set-default } { "DEFAULT" string>token set-rule-set-default }
{ "NO_WORD_SEP" f set-rule-set-no-word-sep } { "NO_WORD_SEP" f set-rule-set-no-word-sep }
@ -153,9 +159,10 @@ TAGS>
: parse-rules-tag ( tag -- rule-set ) : parse-rules-tag ( tag -- rule-set )
dup (parse-rules-tag) [ dup (parse-rules-tag) [
swap child-tags [ [
parse-rule-tag dup rule-set-ignore-case? \ ignore-case? set
] curry* each swap child-tags [ parse-rule-tag ] curry* each
] with-scope
] keep ; ] keep ;
: merge-rule-set-props ( props rule-set -- ) : merge-rule-set-props ( props rule-set -- )

18
extra/xmode/marker/marker-tests.factor
View File

@ -109,3 +109,21 @@ IN: temporary
] [ ] [
f "$FOO" "shellscript" load-mode tokenize-line nip f "$FOO" "shellscript" load-mode tokenize-line nip
] unit-test ] unit-test
[
{
T{ token f "AND" KEYWORD1 }
}
] [
f "AND" "pascal" load-mode tokenize-line nip
] unit-test
[
{
T{ token f "Comment {" COMMENT1 }
T{ token f "XXX" COMMENT1 }
T{ token f "}" COMMENT1 }
}
] [
f "Comment {XXX}" "rebol" load-mode tokenize-line nip
] unit-test

33
extra/xmode/marker/marker.factor
View File

@ -15,8 +15,8 @@ assocs combinators combinators.lib strings regexp splitting ;
[ dup [ digit? ] contains? ] [ dup [ digit? ] contains? ]
[ [
dup [ digit? ] all? [ dup [ digit? ] all? [
current-rule-set rule-set-digit-re dup current-rule-set rule-set-digit-re
[ dupd 2drop f ] [ drop f ] if dup [ dupd matches? ] [ drop f ] if
] unless* ] unless*
] ]
} && nip ; } && nip ;
@ -26,7 +26,7 @@ assocs combinators combinators.lib strings regexp splitting ;
: resolve-delegate ( name -- rules ) : resolve-delegate ( name -- rules )
dup string? [ dup string? [
"::" split1 [ swap load-mode at ] [ rule-sets get at ] if* "::" split1 [ swap load-mode ] [ rule-sets get ] if* at
] when ; ] when ;
: rule-set-keyword-maps ( ruleset -- seq ) : rule-set-keyword-maps ( ruleset -- seq )
@ -45,13 +45,6 @@ assocs combinators combinators.lib strings regexp splitting ;
dup mark-number [ ] [ mark-keyword ] ?if dup mark-number [ ] [ mark-keyword ] ?if
[ prev-token, ] when* ; [ prev-token, ] when* ;
: check-terminate-char ( -- )
current-rule-set rule-set-terminate-char [
position get <= [
terminated? on
] when
] when* ;
: current-char ( -- char ) : current-char ( -- char )
position get line get nth ; position get line get nth ;
@ -74,11 +67,22 @@ GENERIC: text-matches? ( position text -- match-count/f )
M: f text-matches? 2drop f ; M: f text-matches? 2drop f ;
M: string text-matches? M: string text-matches?
! XXX ignore case
>r line get swap tail-slice r> >r line get swap tail-slice r>
[ head? ] keep length and ; [ head? ] keep length and ;
! M: regexp text-matches? ... ; M: ignore-case text-matches?
>r line get swap tail-slice r>
ignore-case-string
2dup shorter? [
2drop f
] [
[ length head-slice ] keep
[ [ >upper ] 2apply sequence= ] keep
length and
] if ;
M: regexp text-matches?
2drop f ; ! >r line get swap tail-slice r> match-head ;
: rule-start-matches? ( rule -- match-count/f ) : rule-start-matches? ( rule -- match-count/f )
dup rule-start tuck swap can-match-here? [ dup rule-start tuck swap can-match-here? [
@ -284,8 +288,6 @@ M: mark-previous-rule handle-rule-start
: mark-token-loop ( -- ) : mark-token-loop ( -- )
position get line get length < [ position get line get length < [
check-terminate-char
{ {
[ check-end-delegate ] [ check-end-delegate ]
[ check-every-rule ] [ check-every-rule ]
@ -302,8 +304,7 @@ M: mark-previous-rule handle-rule-start
: unwind-no-line-break ( -- ) : unwind-no-line-break ( -- )
context get line-context-parent [ context get line-context-parent [
line-context-in-rule rule-no-line-break? line-context-in-rule rule-no-line-break? [
terminated? get or [
pop-context pop-context
unwind-no-line-break unwind-no-line-break
] when ] when

1
extra/xmode/marker/state/state.factor
View File

@ -16,7 +16,6 @@ SYMBOL: seen-whitespace-end?
SYMBOL: escaped? SYMBOL: escaped?
SYMBOL: process-escape? SYMBOL: process-escape?
SYMBOL: delegate-end-escaped? SYMBOL: delegate-end-escaped?
SYMBOL: terminated?
: current-rule ( -- rule ) : current-rule ( -- rule )
context get line-context-in-rule ; context get line-context-in-rule ;

26
extra/xmode/rules/rules.factor
View File

@ -1,7 +1,11 @@
USING: xmode.tokens xmode.keyword-map kernel USING: xmode.tokens xmode.keyword-map kernel
sequences vectors assocs strings memoize ; sequences vectors assocs strings memoize regexp ;
IN: xmode.rules IN: xmode.rules
TUPLE: ignore-case string ;
C: <ignore-case> ignore-case
! Based on org.gjt.sp.jedit.syntax.ParserRuleSet ! Based on org.gjt.sp.jedit.syntax.ParserRuleSet
TUPLE: rule-set TUPLE: rule-set
name name
@ -20,12 +24,11 @@ no-word-sep
: init-rule-set ( ruleset -- ) : init-rule-set ( ruleset -- )
#! Call after constructor. #! Call after constructor.
>r H{ } clone H{ } clone V{ } clone f <keyword-map> r> >r H{ } clone H{ } clone V{ } clone r>
{ {
set-rule-set-rules set-rule-set-rules
set-rule-set-props set-rule-set-props
set-rule-set-imports set-rule-set-imports
set-rule-set-keywords
} set-slots ; } set-slots ;
: <rule-set> ( -- ruleset ) : <rule-set> ( -- ruleset )
@ -46,8 +49,9 @@ MEMO: standard-rule-set ( id -- ruleset )
] when* ; ] when* ;
: rule-set-no-word-sep* ( ruleset -- str ) : rule-set-no-word-sep* ( ruleset -- str )
dup rule-set-keywords keyword-map-no-word-sep* dup rule-set-no-word-sep
swap rule-set-no-word-sep "_" 3append ; swap rule-set-keywords dup [ keyword-map-no-word-sep* ] when
"_" 3append ;
! Match restrictions ! Match restrictions
TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ; TUPLE: matcher text at-line-start? at-whitespace-end? at-word-start? ;
@ -97,10 +101,20 @@ TUPLE: escape-rule ;
escape-rule construct-rule escape-rule construct-rule
[ set-rule-start ] keep ; [ set-rule-start ] keep ;
GENERIC: text-hash-char ( text -- ch )
M: f text-hash-char ;
M: string text-hash-char first ;
M: ignore-case text-hash-char ignore-case-string first ;
M: regexp text-hash-char drop f ;
: rule-chars* ( rule -- string ) : rule-chars* ( rule -- string )
dup rule-chars dup rule-chars
swap rule-start matcher-text swap rule-start matcher-text
dup string? [ first add ] [ drop ] if ; text-hash-char [ add ] when* ;
: add-rule ( rule ruleset -- ) : add-rule ( rule ruleset -- )
>r dup rule-chars* >upper swap >r dup rule-chars* >upper swap