Merge branch 'master' into new_ui

basis/base64/base64.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators io io.binary io.encodings.binary
 io.streams.byte-array io.streams.string kernel math namespaces
-sequences strings ;
+sequences strings io.crlf ;
 IN: base64
 
 <PRIVATE
@@ -32,7 +32,7 @@ SYMBOL: column
 : write1-lines ( ch -- )
     write1
     column get [
-        1+ [ 76 = [ "\r\n" write ] when ]
+        1+ [ 76 = [ crlf ] when ]
         [ 76 mod column set ] bi
     ] when* ;
 

basis/base64/tags.txt

@@ -0,0 +1,2 @@
+parsing
+web

basis/functors/functors-tests.factor

@@ -34,7 +34,7 @@ WW DEFINES ${W}${W}
 
 WHERE
 
-: WW W twice ; inline
+: WW ( a -- b ) \ W twice ; inline
 
 ;FUNCTOR
 

basis/functors/functors.factor

@@ -1,17 +1,42 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel quotations classes.tuple make combinators generic
 words interpolate namespaces sequences io.streams.string fry
 classes.mixin effects lexer parser classes.tuple.parser
 effects.parser locals.types locals.parser
-locals.rewrite.closures vocabs.parser ;
+locals.rewrite.closures vocabs.parser arrays accessors ;
 IN: functors
 
+! This is a hack
+
 : scan-param ( -- obj )
     scan-object dup special? [ literalize ] unless ;
 
 : define* ( word def effect -- ) pick set-word define-declared ;
 
+TUPLE: fake-quotation seq ;
+
+GENERIC: >fake-quotations ( quot -- fake )
+
+M: callable >fake-quotations
+    >array >fake-quotations fake-quotation boa ;
+
+M: array >fake-quotations [ >fake-quotations ] { } map-as ;
+
+M: object >fake-quotations ;
+
+GENERIC: fake-quotations> ( fake -- quot )
+
+M: fake-quotation fake-quotations>
+    seq>> [ fake-quotations> ] map >quotation ;
+
+M: array fake-quotations> [ fake-quotations> ] map ;
+
+M: object fake-quotations> ;
+
+: parse-definition* ( -- )
+    parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
+
 : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
 
 : `TUPLE:
@@ -32,7 +57,7 @@ IN: functors
     scan-param parsed
     scan-param parsed
     \ create-method parsed
-    parse-definition parsed
+    parse-definition*
     DEFINE* ; parsing
 
 : `C:
@@ -45,7 +70,7 @@ IN: functors
 : `:
     effect off
     scan-param parsed
-    parse-definition parsed
+    parse-definition*
     DEFINE* ; parsing
 
 : `INSTANCE:

basis/http/http.factor

@@ -6,7 +6,7 @@ quotations arrays byte-arrays math.parser calendar
 calendar.format present urls
 
 io io.encodings io.encodings.iana io.encodings.binary
-io.encodings.8-bit
+io.encodings.8-bit io.crlf
 
 unicode.case unicode.categories
 
@@ -16,12 +16,6 @@ EXCLUDE: fry => , ;
 
 IN: http
 
-: crlf ( -- ) "\r\n" write ;
-
-: read-crlf ( -- bytes )
-    "\r" read-until
-    [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;
-
 : (read-header) ( -- alist )
     [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
 

basis/io/crlf/authors.txt

@@ -0,0 +1,2 @@
+Daniel Ehrenberg
+Slava Pestov

basis/io/crlf/crlf-docs.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup sequences ;
+IN: io.crlf
+
+HELP: crlf
+{ $values }
+{ $description "Prints a carriage return and line feed to the current output stream, used to indicate a newline for certain network protocols." } ;
+
+HELP: read-crlf
+{ $values { "seq" sequence } }
+{ $description "Reads until the next CRLF (carriage return followed by line feed) from the current input stream, throwing an error if there is not a CRLF remaining, or if CR is present without immediately being followed by LF." } ;

basis/io/crlf/crlf.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: io kernel ;
+IN: io.crlf
+
+: crlf ( -- )
+    "\r\n" write ;
+
+: read-crlf ( -- seq )
+    "\r" read-until
+    [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;

basis/io/crlf/summary.txt

@@ -0,0 +1 @@
+Writing and reading until \r\n

basis/io/mmap/functor/functor.factor

@@ -20,9 +20,9 @@ with-mapped-A-file DEFINES with-mapped-${T}-file
 WHERE
 
 : <mapped-A> ( mapped-file -- direct-array )
-    T mapped-file>direct <A> execute ; inline
+    T mapped-file>direct <A> ; inline
 
 : with-mapped-A-file ( path length quot -- )
-    '[ <mapped-A> execute @ ] with-mapped-file ; inline
+    '[ <mapped-A> @ ] with-mapped-file ; inline
 
 ;FUNCTOR

basis/locals/locals-tests.factor

@@ -494,4 +494,6 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 ! Discovered by littledan
 [ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
-[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
+[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
+
+[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test

basis/locals/rewrite/sugar/sugar.factor

@@ -37,7 +37,7 @@ M: array rewrite-literal? [ rewrite-literal? ] contains? ;
 
 M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
 
-M: wrapper rewrite-literal? drop t ;
+M: wrapper rewrite-literal? wrapped>> rewrite-literal? ;
 
 M: hashtable rewrite-literal? drop t ;
 
@@ -53,7 +53,7 @@ GENERIC: rewrite-element ( obj -- )
     [ rewrite-element ] each ;
 
 : rewrite-sequence ( seq -- )
-    [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
+    [ rewrite-elements ] [ length ] [ 0 head ] tri '[ _ _ nsequence ] % ;
 
 M: array rewrite-element
     dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
@@ -63,7 +63,7 @@ M: vector rewrite-element rewrite-sequence ;
 M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 
 M: tuple rewrite-element
-    [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
+    [ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] % ;
 
 M: quotation rewrite-element rewrite-sugar* ;
 
@@ -84,7 +84,7 @@ M: local-word rewrite-element
 M: word rewrite-element literalize , ;
 
 M: wrapper rewrite-element
-    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
+    dup rewrite-literal? [ wrapped>> rewrite-element \ literalize , ] [ , ] if ;
 
 M: object rewrite-element , ;
 
@@ -98,7 +98,8 @@ M: def rewrite-sugar* , ;
 
 M: hashtable rewrite-sugar* rewrite-element ;
 
-M: wrapper rewrite-sugar* rewrite-element ;
+M: wrapper rewrite-sugar*
+    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
 
 M: word rewrite-sugar*
     dup { load-locals get-local drop-locals } memq?

basis/math/blas/cblas/tags.txt

@@ -1,3 +1,2 @@
 math
 bindings
-unportable

basis/math/blas/matrices/matrices.factor

@@ -268,28 +268,28 @@ TUPLE: MATRIX < blas-matrix-base ;
 M: MATRIX element-type
     drop TYPE ;
 M: MATRIX (blas-matrix-like)
-    drop <MATRIX> execute ;
+    drop <MATRIX> ;
 M: VECTOR (blas-matrix-like)
-    drop <MATRIX> execute ;
+    drop <MATRIX> ;
 M: MATRIX (blas-vector-like)
-    drop <VECTOR> execute ;
+    drop <VECTOR> ;
 
 : >MATRIX ( arrays -- matrix )
-    [ >ARRAY execute underlying>> ] (>matrix)
+    [ >ARRAY underlying>> ] (>matrix)
-    <MATRIX> execute ;
+    <MATRIX> ;
 
 M: VECTOR n*M.V+n*V!
-    [ TYPE>ARG execute ] (prepare-gemv)
+    [ TYPE>ARG ] (prepare-gemv)
-    [ XGEMV execute ] dip ;
+    [ XGEMV ] dip ;
 M: MATRIX n*M.M+n*M!
-    [ TYPE>ARG execute ] (prepare-gemm)
+    [ TYPE>ARG ] (prepare-gemm)
-    [ XGEMM execute ] dip ;
+    [ XGEMM ] dip ;
 M: MATRIX n*V(*)V+M!
-    [ TYPE>ARG execute ] (prepare-ger)
+    [ TYPE>ARG ] (prepare-ger)
-    [ XGERU execute ] dip ;
+    [ XGERU ] dip ;
 M: MATRIX n*V(*)Vconj+M!
-    [ TYPE>ARG execute ] (prepare-ger)
+    [ TYPE>ARG ] (prepare-ger)
-    [ XGERC execute ] dip ;
+    [ XGERC ] dip ;
 
 ;FUNCTOR
 

basis/math/blas/matrices/tags.txt

@@ -1,3 +1,2 @@
 math
 bindings
-unportable

basis/math/blas/syntax/syntax.factor

@@ -1,5 +1,5 @@
 USING: kernel math.blas.vectors math.blas.matrices parser
-arrays prettyprint.backend sequences ;
+arrays prettyprint.backend prettyprint.custom sequences ;
 IN: math.blas.syntax
 
 : svector{

basis/math/blas/syntax/tags.txt

@@ -1,2 +1 @@
 math
-unportable

basis/math/blas/vectors/tags.txt

@@ -1,2 +1 @@
 math
-unportable

basis/math/blas/vectors/vectors.factor

@@ -144,26 +144,26 @@ TUPLE: VECTOR < blas-vector-base ;
 : <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
 
 : >VECTOR ( seq -- v )
-    [ >ARRAY execute underlying>> ] [ length ] bi 1 <VECTOR> execute ;
+    [ >ARRAY underlying>> ] [ length ] bi 1 <VECTOR> ;
 
 M: VECTOR clone
     TYPE heap-size (prepare-copy)
-    [ XCOPY execute ] 3dip <VECTOR> execute ;
+    [ XCOPY ] 3dip <VECTOR> ;
 
 M: VECTOR element-type
     drop TYPE ;
 M: VECTOR Vswap
-    (prepare-swap) [ XSWAP execute ] 2dip ;
+    (prepare-swap) [ XSWAP ] 2dip ;
 M: VECTOR Viamax
-    (prepare-nrm2) IXAMAX execute ;
+    (prepare-nrm2) IXAMAX ;
 
 M: VECTOR (blas-vector-like)
-    drop <VECTOR> execute ;
+    drop <VECTOR> ;
 
 M: VECTOR (blas-direct-array)
     [ underlying>> ]
     [ [ length>> ] [ inc>> ] bi * ] bi
-    <DIRECT-ARRAY> execute ;
+    <DIRECT-ARRAY> ;
 
 ;FUNCTOR
 
@@ -180,17 +180,17 @@ XSCAL          IS cblas_${T}scal
 WHERE
 
 M: VECTOR V.
-    (prepare-dot) XDOT execute ;
+    (prepare-dot) XDOT ;
 M: VECTOR V.conj
-    (prepare-dot) XDOT execute ;
+    (prepare-dot) XDOT ;
 M: VECTOR Vnorm
-    (prepare-nrm2) XNRM2 execute ;
+    (prepare-nrm2) XNRM2 ;
 M: VECTOR Vasum
-    (prepare-nrm2) XASUM execute ;
+    (prepare-nrm2) XASUM ;
 M: VECTOR n*V+V!
-    (prepare-axpy) [ XAXPY execute ] dip ;
+    (prepare-axpy) [ XAXPY ] dip ;
 M: VECTOR n*V!
-    (prepare-scal) [ XSCAL execute ] dip ;
+    (prepare-scal) [ XSCAL ] dip ;
 
 ;FUNCTOR
 
@@ -207,13 +207,13 @@ COMPLEX>ARG            DEFINES ${TYPE}-complex>arg
 WHERE
 
 : <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
-    1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
+    1 shift <DIRECT-ARRAY> <complex-sequence> ;
 : >COMPLEX-ARRAY ( sequence -- sequence )
-    <complex-components> >ARRAY execute ;
+    <complex-components> >ARRAY ;
 : COMPLEX>ARG ( complex -- alien )
-    >rect 2array >ARRAY execute underlying>> ;
+    >rect 2array >ARRAY underlying>> ;
 : ARG>COMPLEX ( alien -- complex )
-    2 <DIRECT-ARRAY> execute first2 rect> ;
+    2 <DIRECT-ARRAY> first2 rect> ;
 
 ;FUNCTOR
 
@@ -234,22 +234,22 @@ WHERE
 
 M: VECTOR V.
     (prepare-dot) TYPE <c-object>
-    [ XDOTU_SUB execute ] keep
+    [ XDOTU_SUB ] keep
-    ARG>TYPE execute ;
+    ARG>TYPE ;
 M: VECTOR V.conj
     (prepare-dot) TYPE <c-object>
-    [ XDOTC_SUB execute ] keep
+    [ XDOTC_SUB ] keep
-    ARG>TYPE execute ;
+    ARG>TYPE ;
 M: VECTOR Vnorm
-    (prepare-nrm2) XXNRM2 execute ;
+    (prepare-nrm2) XXNRM2 ;
 M: VECTOR Vasum
-    (prepare-nrm2) XXASUM execute ;
+    (prepare-nrm2) XXASUM ;
 M: VECTOR n*V+V!
-    [ TYPE>ARG execute ] 2dip
+    [ TYPE>ARG ] 2dip
-    (prepare-axpy) [ XAXPY execute ] dip ;
+    (prepare-axpy) [ XAXPY ] dip ;
 M: VECTOR n*V!
-    [ TYPE>ARG execute ] dip
+    [ TYPE>ARG ] dip
-    (prepare-scal) [ XSCAL execute ] dip ;
+    (prepare-scal) [ XSCAL ] dip ;
 
 ;FUNCTOR
 

basis/quoted-printable/authors.txt

@@ -0,0 +1 @@
+Daniel Ehrenberg

basis/quoted-printable/quoted-printable-docs.factor

@@ -0,0 +1,27 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax strings byte-arrays io.encodings.string ;
+IN: quoted-printable
+
+ABOUT: "quoted-printable"
+
+ARTICLE: "quoted-printable" "Quoted printable encoding"
+"The " { $vocab-link "quoted-printable" } " vocabulary implements RFC 2045 part 6.7, providing words for reading and generating quotable printed text."
+{ $subsection >quoted }
+{ $subsection >quoted-lines }
+{ $subsection quoted> } ;
+
+HELP: >quoted
+{ $values { "byte-array" byte-array } { "string" string } }
+{ $description "Encodes a byte array as quoted printable, on a single line." }
+{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word." } ;
+
+HELP: >quoted-lines
+{ $values { "byte-array" byte-array } { "string" string } }
+{ $description "Encodes a byte array as quoted printable, with soft line breaks inserted so the output lines are no longer than 76 characters." }
+{ $warning "To encode a string in quoted printable, first use the " { $link encode } " word with a specific encoding." } ;
+
+HELP: quoted>
+{ $values { "string" string } { "byte-array" byte-array } }
+{ $description "Decodes a quoted printable string into an array of the bytes represented." }
+{ $warning "When decoding something in quoted printable form and using it as a string, be sure to use the " { $link decode } " word rather than simply converting the byte array to a string." } ;

basis/quoted-printable/quoted-printable-tests.factor

@@ -0,0 +1,30 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test quoted-printable multiline io.encodings.string
+sequences io.encodings.8-bit splitting kernel ;
+IN: quoted-printable.tests
+
+[ <" José was the
+person who knew how to write the letters:
+    ő and ü 
+and we didn't know hów tö do thât"> ]
+[ <" Jos=E9 was the
+person who knew how to write the letters:
+    =F5 and =FC=20
+and w=
+e didn't know h=F3w t=F6 do th=E2t"> quoted> latin2 decode ] unit-test
+
+[ <" Jos=E9 was the=0Aperson who knew how to write the letters:=0A    =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t"> ]
+[ <" José was the
+person who knew how to write the letters:
+    ő and ü
+and we didn't know hów tö do thât"> latin2 encode >quoted ] unit-test
+
+: message ( -- str )
+    55 [ "hello" ] replicate concat ;
+
+[ f ] [ message >quoted "=\r\n" swap subseq? ] unit-test
+[ 1 ] [ message >quoted string-lines length ] unit-test
+[ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test
+[ 4 ] [ message >quoted-lines string-lines length ] unit-test
+[ "===o" ] [ message >quoted-lines string-lines [ peek ] "" map-as ] unit-test

basis/quoted-printable/quoted-printable.factor

@@ -0,0 +1,62 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences strings kernel io.encodings.string
+math.order ascii math io io.encodings.utf8 io.streams.string
+combinators.short-circuit math.parser arrays ;
+IN: quoted-printable
+
+! This implements RFC 2045 section 6.7
+
+<PRIVATE
+
+: assure-small ( ch -- ch )
+    dup 256 <
+    [ "Cannot quote a character greater than 255" throw ] unless ;
+
+: printable? ( ch -- ? )
+    {
+        [ CHAR: \s CHAR: < between? ]
+        [ CHAR: > CHAR: ~ between? ]
+        [ CHAR: \t = ]
+    } 1|| ;
+
+: char>quoted ( ch -- str )
+    dup printable? [ 1string ] [
+        assure-small >hex >upper
+        2 CHAR: 0 pad-left 
+        CHAR: = prefix
+    ] if ;
+
+: take-some ( seqs -- seqs seq )
+    0 over [ length + dup 76 >= ] find drop nip
+    [ 1- cut-slice swap ] [ f swap ] if* concat ;
+
+: divide-lines ( strings -- strings )
+    [ dup ] [ take-some ] [ ] produce nip ;
+
+PRIVATE>
+
+: >quoted ( byte-array -- string )
+    [ char>quoted ] { } map-as concat "" like ;
+
+: >quoted-lines ( byte-array -- string )
+    [ char>quoted ] { } map-as
+    divide-lines "=\r\n" join ;
+
+<PRIVATE
+
+: read-char ( byte -- ch )
+    dup CHAR: = = [
+       drop read1 dup CHAR: \n =
+       [ drop read1 read-char ]
+       [ read1 2array hex> ] if
+    ] when ;
+
+: read-quoted ( -- bytes )
+    [ read1 dup ] [ read-char ] [ drop ] B{ } produce-as ;
+
+PRIVATE>
+
+: quoted> ( string -- byte-array )
+    ! Input should already be normalized to make \r\n into \n
+    [ read-quoted ] with-string-reader ;

basis/quoted-printable/summary.txt

@@ -0,0 +1 @@
+Quoted printable encoding/decoding

basis/quoted-printable/tags.txt

@@ -0,0 +1,2 @@
+parsing
+web

basis/smtp/server/server.factor

@@ -4,7 +4,7 @@ USING: combinators kernel prettyprint io io.timeouts sequences
 namespaces io.sockets io.sockets.secure continuations calendar
 io.encodings.ascii io.streams.duplex destructors locals
 concurrency.promises threads accessors smtp.private
-io.sockets.secure.unix.debug ;
+io.sockets.secure.unix.debug io.crlf ;
 IN: smtp.server
 
 ! Mock SMTP server for testing purposes.

basis/smtp/smtp.factor

@@ -6,7 +6,7 @@ io.encodings.utf8 io.timeouts io.sockets io.sockets.secure
 io.encodings.ascii kernel logging sequences combinators
 splitting assocs strings math.order math.parser random system
 calendar summary calendar.format accessors sets hashtables
-base64 debugger classes prettyprint ;
+base64 debugger classes prettyprint io.crlf ;
 IN: smtp
 
 SYMBOL: smtp-domain
@@ -50,12 +50,6 @@ TUPLE: email
 
 <PRIVATE
 
-: crlf ( -- ) "\r\n" write ;
-
-: read-crlf ( -- bytes )
-    "\r" read-until
-    [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;
-
 : command ( string -- ) write crlf flush ;
 
 \ command DEBUG add-input-logging

basis/specialized-arrays/functor/functor.factor

@@ -49,9 +49,9 @@ M: A set-nth-unsafe underlying>> SET-NTH call ;
 
 : >A ( seq -- specialized-array ) A new clone-like ; inline
 
-M: A like drop dup A instance? [ >A execute ] unless ;
+M: A like drop dup A instance? [ >A ] unless ;
 
-M: A new-sequence drop (A) execute ;
+M: A new-sequence drop (A) ;
 
 M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
 
@@ -70,7 +70,7 @@ M: A >pprint-sequence ;
 
 M: A pprint* pprint-object ;
 
-: A{ \ } [ >A execute ] parse-literal ; parsing
+: A{ \ } [ >A ] parse-literal ; parsing
 
 INSTANCE: A sequence
 

basis/specialized-vectors/functor/functor.factor

@@ -18,16 +18,16 @@ WHERE
 
 TUPLE: V { underlying A } { length array-capacity } ;
 
-: <V> ( capacity -- vector ) <A> execute 0 V boa ; inline
+: <V> ( capacity -- vector ) <A> 0 V boa ; inline
 
 M: V like
     drop dup V instance? [
-        dup A instance? [ dup length V boa ] [ >V execute ] if
+        dup A instance? [ dup length V boa ] [ >V ] if
     ] unless ;
 
-M: V new-sequence drop [ <A> execute ] [ >fixnum ] bi V boa ;
+M: V new-sequence drop [ <A> ] [ >fixnum ] bi V boa ;
 
-M: A new-resizable drop <V> execute ;
+M: A new-resizable drop <V> ;
 
 M: V equal? over V instance? [ sequence= ] [ 2drop f ] if ;
 
@@ -39,7 +39,7 @@ M: V >pprint-sequence ;
 
 M: V pprint* pprint-object ;
 
-: V{ \ } [ >V execute ] parse-literal ; parsing
+: V{ \ } [ >V ] parse-literal ; parsing
 
 INSTANCE: V growable
 

basis/xml/utilities/utilities.factor

@@ -19,10 +19,6 @@ IN: xml.utilities
 : first-child-tag ( tag -- tag )
     children>> [ tag? ] find nip ;
 
-! * Accessing part of an XML document
-! for tag- words, a start means that it searches all children
-! and no star searches only direct children
-
 : tag-named? ( name elem -- ? )
     dup tag? [ names-match? ] [ 2drop f ] if ;
 
@@ -36,8 +32,6 @@ IN: xml.utilities
     tags@ '[ _ swap tag-named? ] deep-filter ;
 
 : tag-named ( tag name/string -- matching-tag )
-    ! like get-name-tag but only looks at direct children,
-    ! not all the children down the tree.
     assure-name swap [ tag-named? ] with find nip ;
 
 : tags-named ( tag name/string -- tags-seq )
@@ -58,7 +52,7 @@ IN: xml.utilities
 : deep-tags-with-attr ( tag attr-value attr-name -- tags-seq )
     tags@ '[ _ _ tag-with-attr? ] deep-filter ;
 
-: get-id ( tag id -- elem ) ! elem=tag.getElementById(id)
+: get-id ( tag id -- elem )
     "id" deep-tag-with-attr ;
 
 : deep-tags-named-with-attr ( tag tag-name attr-value attr-name -- tags )

misc/fuel/fuel-syntax.el

@@ -233,16 +233,11 @@
     ;; Default is word constituent
     (dotimes (i 256)
       (modify-syntax-entry i "w" table))
-
     ;; Whitespace (TAB is not whitespace)
     (modify-syntax-entry ?\f " " table)
     (modify-syntax-entry ?\r " " table)
     (modify-syntax-entry ?\  " " table)
     (modify-syntax-entry ?\n " " table)
-
-    ;; Char quote
-    (modify-syntax-entry ?\\ "/" table)
-
     table))
 
 (defconst fuel-syntax--syntactic-keywords
@@ -254,9 +249,9 @@
     (" \\((\\)( \\([^\n]*\\) )\\()\\)\\( \\|\n\\)" (1 "<b") (2 "w") (3 ">b"))
     (" \\((\\) \\([^\n]*\\) \\()\\)\\( \\|\n\\)" (1 "<b") (2 "w") (3 ">b"))
     ;; Strings
-    ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\)"
+    ("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)"
-     (3 "\"") (4 "\""))
+     (3 "\"") (5 "\""))
-    ("\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\|$\\)" (1 "\"") (2 "\""))
+    ("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\""))
     ("\\_<<\\(\"\\)\\_>" (1 "<b"))
     ("\\_<\\(\"\\)>\\_>" (1 ">b"))
     ;; Multiline constructs