diff --git a/basis/help/tips/tips-docs.factor b/basis/help/tips/tips-docs.factor index 750eff7a52..48ed65b318 100644 --- a/basis/help/tips/tips-docs.factor +++ b/basis/help/tips/tips-docs.factor @@ -20,6 +20,8 @@ TIP: "Power tools: " { $links see edit help about apropos time infer. } ; TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link POSTPONE: TIP: } " parsing word." ; +TIP: "Try some simple demo applications, then look at the source code in " { $snippet "extra/" } ": " { $code "\"demos\" run" } ; + HELP: TIP: { $syntax "TIP: content ;" } { $values { "content" "a markup element" } } diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index adcfdfb00d..bc07006d62 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -11,6 +11,7 @@ CONSTANT: horizontal { 1 0 } CONSTANT: vertical { 0 1 } TUPLE: gadget < rect +id pref-dim parent children @@ -28,7 +29,7 @@ model ; M: gadget equal? 2drop f ; -M: gadget hashcode* drop gadget hashcode* ; +M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ; M: gadget model-changed 2drop ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index a6bd5c4e29..6f6e7ee95f 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -49,13 +49,13 @@ M: pane-stream stream-element-type drop +character+ ; : pane-caret&mark ( pane -- caret mark ) [ caret>> ] [ mark>> ] bi ; inline -: selected-children ( pane -- seq ) +: selected-subtree ( pane -- seq ) [ pane-caret&mark sort-pair ] keep gadget-subtree ; M: pane gadget-selection? pane-caret&mark and ; M: pane gadget-selection ( pane -- string/f ) - selected-children gadget-text ; + selected-subtree gadget-text ; : init-prototype ( pane -- pane ) +baseline+ >>align >>prototype ; inline @@ -72,31 +72,12 @@ M: pane gadget-selection ( pane -- string/f ) [ >>last-line ] [ 1 track-add ] bi dup prepare-last-line ; inline -GENERIC: draw-selection ( loc obj -- ) - -: if-fits ( rect quot -- ) - [ clip get over contains-rect? ] dip [ drop ] if ; inline - -M: gadget draw-selection ( loc gadget -- ) - swap offset-rect [ - rect-bounds gl-fill-rect - ] if-fits ; - -M: node draw-selection ( loc node -- ) - 2dup value>> swap offset-rect [ - drop 2dup - [ value>> loc>> v+ ] keep - children>> [ draw-selection ] with each - ] if-fits 2drop ; - -M: pane draw-gadget* +M: pane selected-children dup gadget-selection? [ - [ selection-color>> gl-color ] - [ - [ loc>> vneg ] keep selected-children - [ draw-selection ] with each - ] bi - ] [ drop ] if ; + [ selected-subtree leaves ] + [ selection-color>> ] + bi + ] [ drop f f ] if ; : scroll-pane ( pane -- ) dup scrolls?>> [ scroll>bottom ] [ drop ] if ; diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index 4c8f7c24e5..09c26fd271 100755 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math.rectangles math.vectors namespaces kernel accessors -combinators sequences opengl opengl.gl opengl.glu colors +assocs combinators sequences opengl opengl.gl opengl.glu colors colors.constants ui.gadgets ui.pens ; IN: ui.render @@ -55,21 +55,57 @@ SYMBOL: origin GENERIC: draw-children ( gadget -- ) +! For gadget selection +SYMBOL: selected-gadgets + +SYMBOL: selection-background + +GENERIC: selected-children ( gadget -- assoc/f selection-background ) + +M: gadget selected-children drop f f ; + +! For text rendering +SYMBOL: background + +SYMBOL: foreground + +GENERIC: gadget-background ( gadget -- color ) + +M: gadget gadget-background dup interior>> pen-background ; + +GENERIC: gadget-foreground ( gadget -- color ) + +M: gadget gadget-foreground dup interior>> pen-foreground ; + +> gl-fill-rect ; + +: draw-standard-background ( object -- ) + dup interior>> dup [ draw-interior ] [ 2drop ] if ; + +: draw-background ( gadget -- ) + origin get [ + [ + dup selected-gadgets get key? + [ draw-selection-background ] + [ draw-standard-background ] if + ] [ draw-gadget* ] bi + ] with-translation ; + +: draw-border ( object -- ) + dup boundary>> dup [ + origin get [ draw-boundary ] with-translation + ] [ 2drop ] if ; + +PRIVATE> + : (draw-gadget) ( gadget -- ) dup loc>> origin get v+ origin [ - [ - origin get [ - [ dup interior>> dup [ draw-interior ] [ 2drop ] if ] - [ draw-gadget* ] - bi - ] with-translation - ] - [ draw-children ] - [ - dup boundary>> dup [ - origin get [ draw-boundary ] with-translation - ] [ 2drop ] if - ] tri + [ draw-background ] [ draw-children ] [ draw-border ] tri ] with-variable ; : >absolute ( rect -- rect ) @@ -88,27 +124,24 @@ GENERIC: draw-children ( gadget -- ) [ [ (draw-gadget) ] with-clipping ] } cond ; -! For text rendering -SYMBOL: background - -SYMBOL: foreground - -GENERIC: gadget-background ( gadget -- color ) - -M: gadget gadget-background dup interior>> pen-background ; - -GENERIC: gadget-foreground ( gadget -- color ) - -M: gadget gadget-foreground dup interior>> pen-foreground ; - M: gadget draw-children - [ visible-children ] - [ gadget-background ] - [ gadget-foreground ] tri [ - [ foreground set ] when* - [ background set ] when* - [ draw-gadget ] each - ] with-scope ; + dup children>> [ + { + [ visible-children ] + [ selected-children ] + [ gadget-background ] + [ gadget-foreground ] + } cleave [ + + { + [ [ selected-gadgets set ] when* ] + [ [ selection-background set ] when* ] + [ [ background set ] when* ] + [ [ foreground set ] when* ] + } spread + [ draw-gadget ] each + ] with-scope + ] [ drop ] if ; CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 } diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor index 63c656205c..9df084210d 100644 --- a/basis/ui/traverse/traverse.factor +++ b/basis/ui/traverse/traverse.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors namespaces make sequences kernel math arrays io -ui.gadgets generic combinators ; +ui.gadgets generic combinators fry sets ; IN: ui.traverse TUPLE: node value children ; @@ -85,3 +85,13 @@ M: node gadget-text* : gadget-at-path ( parent path -- gadget ) [ swap nth-gadget ] each ; + +GENERIC# leaves* 1 ( tree assoc -- ) + +M: node leaves* [ children>> ] dip leaves* ; + +M: array leaves* '[ _ leaves* ] each ; + +M: gadget leaves* conjoin ; + +: leaves ( tree -- assoc ) H{ } clone [ leaves* ] keep ; \ No newline at end of file diff --git a/basis/unicode/categories/categories-tests.factor b/basis/unicode/categories/categories-tests.factor index 1e718cf9b7..0970df7ad8 100644 --- a/basis/unicode/categories/categories-tests.factor +++ b/basis/unicode/categories/categories-tests.factor @@ -12,3 +12,8 @@ IN: unicode.categories.tests [ "Lo" ] [ HEX: 3450 category ] unit-test [ "Lo" ] [ HEX: 4DB5 category ] unit-test [ "Cs" ] [ HEX: DD00 category ] unit-test +[ t ] [ CHAR: \t blank? ] unit-test +[ t ] [ CHAR: \s blank? ] unit-test +[ t ] [ CHAR: \r blank? ] unit-test +[ t ] [ CHAR: \n blank? ] unit-test +[ f ] [ CHAR: a blank? ] unit-test diff --git a/basis/unicode/categories/categories.factor b/basis/unicode/categories/categories.factor index 126c03c869..4ca5c9a90e 100644 --- a/basis/unicode/categories/categories.factor +++ b/basis/unicode/categories/categories.factor @@ -3,7 +3,7 @@ USING: unicode.categories.syntax sequences unicode.data ; IN: unicode.categories -CATEGORY: blank Zs Zl Zp | "\r\n" member? ; +CATEGORY: blank Zs Zl Zp | "\r\n\t" member? ; CATEGORY: letter Ll | "Other_Lowercase" property? ; CATEGORY: LETTER Lu | "Other_Uppercase" property? ; CATEGORY: Letter Lu Ll Lt Lm Lo Nl ; diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index 707caf3188..eb8e452ca4 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -65,9 +65,8 @@ HELP: derive-url } ; HELP: ensure-port -{ $values { "url" url } } -{ $description "If the URL does not specify a port number, fill in the default for the URL's protocol. If the protocol is unknown, the port number is not changed." } -{ $side-effects "url" } +{ $values { "url" url } { "url'" url } } +{ $description "If the URL does not specify a port number, create a new URL which is equal except the port number is set to the default for the URL's protocol. If the protocol is unknown, outputs an exact copy of the input URL." } { $examples { $example "USING: accessors prettyprint urls ;" diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 38d0016d56..1e886ae3e2 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -175,8 +175,8 @@ PRIVATE> ] [ protocol>> ] bi secure-protocol? [ >secure-addr ] when ; -: ensure-port ( url -- url ) - dup protocol>> '[ _ protocol-port or ] change-port ; +: ensure-port ( url -- url' ) + clone dup protocol>> '[ _ protocol-port or ] change-port ; ! Literal syntax SYNTAX: URL" lexer get skip-blank parse-string >url parsed ; diff --git a/extra/c/preprocessor/authors.txt b/extra/c/preprocessor/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/c/preprocessor/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/c/preprocessor/preprocessor-tests.factor b/extra/c/preprocessor/preprocessor-tests.factor new file mode 100644 index 0000000000..d86b85a1b1 --- /dev/null +++ b/extra/c/preprocessor/preprocessor-tests.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test c.preprocessor kernel accessors ; +IN: c.preprocessor.tests + +[ "vocab:c/tests/test1/test1.c" start-preprocess-file ] +[ include-nested-too-deeply? ] must-fail-with + +[ "yo\n\n\n\nyo4\n" ] +[ "vocab:c/tests/test2/test2.c" start-preprocess-file nip ] unit-test + +[ "vocab:c/tests/test3/test3.c" start-preprocess-file ] +[ "\"BOO\"" = ] must-fail-with + +[ V{ "\"omg\"" "\"lol\"" } ] +[ "vocab:c/tests/test4/test4.c" start-preprocess-file drop warnings>> ] unit-test diff --git a/extra/c/preprocessor/preprocessor.factor b/extra/c/preprocessor/preprocessor.factor new file mode 100644 index 0000000000..89292eb74b --- /dev/null +++ b/extra/c/preprocessor/preprocessor.factor @@ -0,0 +1,155 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: html.parser.state io io.encodings.utf8 io.files +io.streams.string kernel combinators accessors io.pathnames +fry sequences arrays locals namespaces io.directories +assocs math splitting make ; +IN: c.preprocessor + +: initial-library-paths ( -- seq ) + V{ "/usr/include" } clone ; + +TUPLE: preprocessor-state library-paths symbol-table +include-nesting include-nesting-max processing-disabled? +ifdef-nesting warnings ; + +: ( -- preprocessor-state ) + preprocessor-state new + initial-library-paths >>library-paths + H{ } clone >>symbol-table + 0 >>include-nesting + 200 >>include-nesting-max + 0 >>ifdef-nesting + V{ } clone >>warnings ; + +DEFER: preprocess-file + +ERROR: unknown-c-preprocessor state-parser name ; + +ERROR: bad-include-line line ; + +ERROR: header-file-missing path ; + +:: read-standard-include ( preprocessor-state path -- ) + preprocessor-state dup library-paths>> + [ path append-path exists? ] find nip + [ + dup [ + path append-path + preprocess-file + ] with-directory + ] [ + ! path header-file-missing + drop + ] if* ; + +:: read-local-include ( preprocessor-state path -- ) + current-directory get path append-path dup :> full-path + dup exists? [ + [ preprocessor-state ] dip preprocess-file + ] [ + ! full-path header-file-missing + drop + ] if ; + +: handle-include ( preprocessor-state state-parser -- ) + skip-whitespace advance dup previous { + { CHAR: < [ CHAR: > take-until-object read-standard-include ] } + { CHAR: " [ CHAR: " take-until-object read-local-include ] } + [ bad-include-line ] + } case ; + +: (readlns) ( -- ) + readln "\\" ?tail [ , ] dip [ (readlns) ] when ; + +: readlns ( -- string ) [ (readlns) ] { } make concat ; + +: handle-define ( preprocessor-state state-parser -- ) + [ take-token ] [ take-rest ] bi + "\\" ?tail [ readlns append ] when + spin symbol-table>> set-at ; + +: handle-undef ( preprocessor-state state-parser -- ) + take-token swap symbol-table>> delete-at ; + +: handle-ifdef ( preprocessor-state state-parser -- ) + [ [ 1 + ] change-ifdef-nesting ] dip + take-token over symbol-table>> key? + [ drop ] [ t >>processing-disabled? drop ] if ; + +: handle-ifndef ( preprocessor-state state-parser -- ) + [ [ 1 + ] change-ifdef-nesting ] dip + take-token over symbol-table>> key? + [ t >>processing-disabled? drop ] + [ drop ] if ; + +: handle-endif ( preprocessor-state state-parser -- ) + drop [ 1 - ] change-ifdef-nesting drop ; + +: handle-error ( preprocessor-state state-parser -- ) + skip-whitespace + nip take-rest throw ; + +: handle-warning ( preprocessor-state state-parser -- ) + skip-whitespace + take-rest swap warnings>> push ; + +: parse-directive ( preprocessor-state state-parser string -- ) + { + { "warning" [ handle-warning ] } + { "error" [ handle-error ] } + { "include" [ handle-include ] } + { "define" [ handle-define ] } + { "undef" [ handle-undef ] } + { "ifdef" [ handle-ifdef ] } + { "ifndef" [ handle-ifndef ] } + { "endif" [ handle-endif ] } + { "if" [ 2drop ] } + { "elif" [ 2drop ] } + { "else" [ 2drop ] } + { "pragma" [ 2drop ] } + { "include_next" [ 2drop ] } + [ unknown-c-preprocessor ] + } case ; + +: parse-directive-line ( preprocessor-state state-parser -- ) + advance dup take-token + pick processing-disabled?>> [ + "endif" = [ + drop f >>processing-disabled? + [ 1 - ] change-ifdef-nesting + drop + ] [ 2drop ] if + ] [ + parse-directive + ] if ; + +: preprocess-line ( preprocessor-state state-parser -- ) + skip-whitespace dup current CHAR: # = + [ parse-directive-line ] + [ swap processing-disabled?>> [ drop ] [ write-full nl ] if ] if ; + +: preprocess-lines ( preprocessor-state -- ) + readln + [ [ preprocess-line ] [ drop preprocess-lines ] 2bi ] + [ drop ] if* ; + +ERROR: include-nested-too-deeply ; + +: check-nesting ( preprocessor-state -- preprocessor-state ) + [ 1 + ] change-include-nesting + dup [ include-nesting>> ] [ include-nesting-max>> ] bi > [ + include-nested-too-deeply + ] when ; + +: preprocess-file ( preprocessor-state path -- ) + [ check-nesting ] dip + [ utf8 [ preprocess-lines ] with-file-reader ] + [ drop [ 1 - ] change-include-nesting drop ] 2bi ; + +: start-preprocess-file ( path -- preprocessor-state string ) + dup parent-directory [ + [ + [ dup ] dip preprocess-file + ] with-string-writer + ] with-directory ; diff --git a/extra/c/tests/test1/README b/extra/c/tests/test1/README new file mode 100644 index 0000000000..99873133b2 --- /dev/null +++ b/extra/c/tests/test1/README @@ -0,0 +1 @@ +Tests if the preprocessor bails on an infinite loop caused by mutually recursive #include lines. diff --git a/extra/c/tests/test1/hi.h b/extra/c/tests/test1/hi.h new file mode 100644 index 0000000000..c9f337c47a --- /dev/null +++ b/extra/c/tests/test1/hi.h @@ -0,0 +1 @@ +#include "lo.h" diff --git a/extra/c/tests/test1/lo.h b/extra/c/tests/test1/lo.h new file mode 100644 index 0000000000..d59fdd272e --- /dev/null +++ b/extra/c/tests/test1/lo.h @@ -0,0 +1 @@ +#include "hi.h" diff --git a/extra/c/tests/test1/test1.c b/extra/c/tests/test1/test1.c new file mode 100644 index 0000000000..d59fdd272e --- /dev/null +++ b/extra/c/tests/test1/test1.c @@ -0,0 +1 @@ +#include "hi.h" diff --git a/extra/c/tests/test2/README b/extra/c/tests/test2/README new file mode 100644 index 0000000000..4244828197 --- /dev/null +++ b/extra/c/tests/test2/README @@ -0,0 +1 @@ +Tests whether #define and #ifdef/#endif work in the positive case. diff --git a/extra/c/tests/test2/test2.c b/extra/c/tests/test2/test2.c new file mode 100644 index 0000000000..4cc4191db1 --- /dev/null +++ b/extra/c/tests/test2/test2.c @@ -0,0 +1,17 @@ +#define YO +#ifdef YO +yo +#endif + +#define YO2 +#ifndef YO2 +yo2 +#endif + +#ifdef YO3 +yo3 +#endif + +#ifndef YO4 +yo4 +#endif diff --git a/extra/c/tests/test3/README b/extra/c/tests/test3/README new file mode 100644 index 0000000000..4244828197 --- /dev/null +++ b/extra/c/tests/test3/README @@ -0,0 +1 @@ +Tests whether #define and #ifdef/#endif work in the positive case. diff --git a/extra/c/tests/test3/test3.c b/extra/c/tests/test3/test3.c new file mode 100644 index 0000000000..8d08e836b2 --- /dev/null +++ b/extra/c/tests/test3/test3.c @@ -0,0 +1 @@ +#error "BOO" diff --git a/extra/c/tests/test4/test4.c b/extra/c/tests/test4/test4.c new file mode 100644 index 0000000000..5acd20da67 --- /dev/null +++ b/extra/c/tests/test4/test4.c @@ -0,0 +1,2 @@ +#warning "omg" +#warning "lol" diff --git a/extra/demos/demos.factor b/extra/demos/demos.factor index 8c55945105..dfd73f1236 100644 --- a/extra/demos/demos.factor +++ b/extra/demos/demos.factor @@ -1,22 +1,16 @@ - -USING: kernel fry sequences - vocabs.loader help.vocabs - ui ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers - ui.tools.listener - accessors ; - +USING: kernel fry sequences vocabs.loader help.vocabs ui +ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.borders +ui.gadgets.scrollers ui.tools.listener accessors ; IN: demos : demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ; : ( vocab-name -- button ) - dup '[ drop [ _ run ] call-listener ] ; + dup '[ drop [ _ run ] \ run call-listener ] ; : ( -- gadget ) - 1 >>fill demo-vocabs [ add-gadget ] each ; + 1 >>fill { 2 2 } >>gap demo-vocabs [ add-gadget ] each ; -: demos ( -- ) [ "Demos" open-window ] with-ui ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: demos ( -- ) [ { 2 2 } "Demos" open-window ] with-ui ; MAIN: demos \ No newline at end of file diff --git a/extra/html/parser/state/state-tests.factor b/extra/html/parser/state/state-tests.factor index 63916a3c1c..75db1a373e 100644 --- a/extra/html/parser/state/state-tests.factor +++ b/extra/html/parser/state/state-tests.factor @@ -93,3 +93,9 @@ IN: html.parser.state.tests [ "abcd e \\\"f g" ] [ "\"abcd e \\\"f g\"" CHAR: \ CHAR: " take-token* ] unit-test + +[ "" ] +[ "" take-rest ] unit-test + +[ "" ] +[ "abc" dup "abc" take-sequence drop take-rest ] unit-test diff --git a/extra/html/parser/state/state.factor b/extra/html/parser/state/state.factor index 86adb0f914..5f845ce810 100644 --- a/extra/html/parser/state/state.factor +++ b/extra/html/parser/state/state.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces math kernel sequences accessors fry circular unicode.case unicode.categories locals combinators.short-circuit -make combinators ; +make combinators io splitting ; IN: html.parser.state @@ -74,8 +74,12 @@ TUPLE: state-parser sequence n ; : skip-whitespace ( state-parser -- state-parser ) [ [ current blank? not ] take-until drop ] keep ; +: take-rest-slice ( state-parser -- sequence/f ) + [ sequence>> ] [ n>> ] bi + 2dup [ length ] dip < [ 2drop f ] [ tail-slice ] if ; inline + : take-rest ( state-parser -- sequence ) - [ drop f ] take-until ; inline + [ take-rest-slice ] [ sequence>> like ] bi ; : take-until-object ( state-parser obj -- sequence ) '[ current _ = ] take-until ; @@ -111,3 +115,6 @@ TUPLE: state-parser sequence n ; : take-token ( state-parser -- string/f ) CHAR: \ CHAR: " take-token* ; + +: write-full ( state-parser -- ) sequence>> write ; +: write-rest ( state-parser -- ) take-rest write ; diff --git a/extra/peg/pl0/pl0.factor b/extra/peg/pl0/pl0.factor index eff923dc01..179e03f1cf 100644 --- a/extra/peg/pl0/pl0.factor +++ b/extra/peg/pl0/pl0.factor @@ -6,20 +6,20 @@ IN: peg.pl0 #! Grammar for PL/0 based on http://en.wikipedia.org/wiki/PL/0 -EBNF: pl0 +EBNF: pl0 -block = { "CONST" ident "=" number { "," ident "=" number }* ";" }? - { "VAR" ident { "," ident }* ";" }? - { "PROCEDURE" ident ";" { block ";" }? }* statement -statement = { ident ":=" expression - | "CALL" ident - | "BEGIN" statement { ";" statement }* "END" - | "IF" condition "THEN" statement - | "WHILE" condition "DO" statement }? +block = { "CONST" ident "=" number { "," ident "=" number }* ";" }? + { "VAR" ident { "," ident }* ";" }? + { "PROCEDURE" ident ";" { block ";" }? }* statement +statement = { ident ":=" expression + | "CALL" ident + | "BEGIN" statement { ";" statement }* "END" + | "IF" condition "THEN" statement + | "WHILE" condition "DO" statement }? condition = { "ODD" expression } | { expression ("=" | "#" | "<=" | "<" | ">=" | ">") expression } -expression = {"+" | "-"}? term { {"+" | "-"} term }* -term = factor { {"*" | "/"} factor }* +expression = {"+" | "-"}? term { {"+" | "-"} term }* +term = factor { {"*" | "/"} factor }* factor = ident | number | "(" expression ")" ident = (([a-zA-Z])+) => [[ >string ]] digit = ([0-9]) => [[ digit> ]] diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 5961d9e86f..bc1bb900ce 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -58,6 +58,7 @@ (number constant "integers and floats") (ratio constant "ratios") (declaration keyword "declaration words") + (ebnf-form constant "EBNF: ... ;EBNF form") (parsing-word keyword "parsing words") (setter-word function-name "setter words (>>foo)") (getter-word function-name "getter words (foo>>)") @@ -75,7 +76,9 @@ (defun fuel-font-lock--syntactic-face (state) (if (nth 3 state) 'factor-font-lock-string (let ((c (char-after (nth 8 state)))) - (cond ((or (char-equal c ?\ ) (char-equal c ?\n)) + (cond ((or (char-equal c ?\ ) + (char-equal c ?\n) + (char-equal c ?E)) (save-excursion (goto-char (nth 8 state)) (beginning-of-line) @@ -85,6 +88,8 @@ 'factor-font-lock-symbol) ((looking-at-p "C-ENUM:\\( \\|\n\\)") 'factor-font-lock-constant) + ((looking-at-p "E") + 'factor-font-lock-ebnf-form) (t 'default)))) ((or (char-equal c ?U) (char-equal c ?C)) 'factor-font-lock-parsing-word) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 4cff58ae3b..7aba6282d6 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -48,7 +48,7 @@ "B" "BIN:" "C:" "C-ENUM:" "C-STRUCT:" "C-UNION:" "CHAR:" "CONSTANT:" "call-next-method" "DEFER:" - "ERROR:" "EXCLUDE:" + "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" "f" "FORGET:" "FROM:" "FUNCTION:" "GENERIC#" "GENERIC:" "HELP:" "HEX:" "HOOK:" @@ -254,6 +254,8 @@ ("\\_<<\\(\"\\)\\_>" (1 "\\_>" (1 ">b")) ;; Multiline constructs + ("\\_<\\(E\\)BNF:\\( \\|\n\\)" (1 "" (1 ">b")) ("\\_<\\(U\\)SING: \\(;\\)" (1 "b")) ("\\_b"))