Merge branch 'master' of git://factorcode.org/git/factor

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/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/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/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