Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
ddd8c2b67e
|
|
@ -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* ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
parsing
|
||||
web
|
||||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
Daniel Ehrenberg
|
||||
Slava Pestov
|
||||
|
|
@ -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." } ;
|
||||
|
|
@ -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* ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Writing and reading until \r\n
|
||||
|
|
@ -0,0 +1 @@
|
|||
Daniel Ehrenberg
|
||||
|
|
@ -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." } ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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 ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Quoted printable encoding/decoding
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
parsing
|
||||
web
|
||||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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\\)"
|
||||
(3 "\"") (4 "\""))
|
||||
("\\(\"\\)[^\n\r\f]*?\\(\"\\)\\( \\|\n\\|$\\)" (1 "\"") (2 "\""))
|
||||
("\\( \\|^\\)\\(DLL\\|P\\|SBUF\\)\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)"
|
||||
(3 "\"") (5 "\""))
|
||||
("\\(\"\\)\\([^\n\r\f\\\"]\\|\\\\.\\)*?\\(\"\\)" (1 "\"") (3 "\""))
|
||||
("\\_<<\\(\"\\)\\_>" (1 "<b"))
|
||||
("\\_<\\(\"\\)>\\_>" (1 ">b"))
|
||||
;; Multiline constructs
|
||||
|
|
|
|||
Loading…
Reference in New Issue