diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index 40bc6615fa..00787f9da2 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -6,7 +6,7 @@ strings io.styles vectors words system splitting math.parser tuples continuations continuations.private combinators generic.math io.streams.duplex classes compiler.units generic.standard vocabs threads threads.private init -kernel.private libc ; +kernel.private libc io.encodings ; IN: debugger GENERIC: error. ( error -- ) @@ -274,6 +274,10 @@ M: thread error-in-thread ( error thread -- ) ] bind ] if ; +M: encode-error summary drop "Character encoding error" ; + +M: decode-error summary drop "Character decoding error" ; + r 2 shift r> BIN: 11 bitand bitor - over stream-read1 prepend-nums HEX: 10000 + + over stream-read1 swap append-nums HEX: 10000 + ] [ 2drop dup stream-read1 drop replacement-char ] if ] when* ; diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index e15a90eda9..58eb42305e 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -8,7 +8,7 @@ calendar.format new-slots accessors ; IN: smtp SYMBOL: smtp-domain -SYMBOL: smtp-server "localhost" 25 smtp-server set-global +SYMBOL: smtp-server "localhost" "smtp" smtp-server set-global SYMBOL: read-timeout 1 minutes read-timeout set-global SYMBOL: esmtp t esmtp set-global @@ -25,8 +25,10 @@ LOG: log-smtp-connection NOTICE ( addrspec -- ) : crlf "\r\n" write ; +: command ( string -- ) write crlf flush ; + : helo ( -- ) - esmtp get "EHLO " "HELO " ? write host-name write crlf ; + esmtp get "EHLO " "HELO " ? host-name append command ; : validate-address ( string -- string' ) #! Make sure we send funky stuff to the server by accident. @@ -34,13 +36,13 @@ LOG: log-smtp-connection NOTICE ( addrspec -- ) [ "Bad e-mail address: " prepend throw ] unless ; : mail-from ( fromaddr -- ) - "MAIL FROM:<" write validate-address write ">" write crlf ; + "MAIL FROM:<" swap validate-address ">" 3append command ; : rcpt-to ( to -- ) - "RCPT TO:<" write validate-address write ">" write crlf ; + "RCPT TO:<" swap validate-address ">" 3append command ; : data ( -- ) - "DATA" write crlf ; + "DATA" command ; : validate-message ( msg -- msg' ) "." over member? [ "Message cannot contain . on a line by itself" throw ] when ; @@ -49,10 +51,10 @@ LOG: log-smtp-connection NOTICE ( addrspec -- ) string-lines validate-message [ write crlf ] each - "." write crlf ; + "." command ; : quit ( -- ) - "QUIT" write crlf ; + "QUIT" command ; LOG: smtp-response DEBUG @@ -85,7 +87,7 @@ LOG: smtp-response DEBUG readln dup multiline? [ 3 head process-multiline ] when ; -: get-ok ( -- ) flush receive-response check-response ; +: get-ok ( -- ) receive-response check-response ; : validate-header ( string -- string' ) dup "\r\n" seq-intersect empty? diff --git a/extra/tools/vocabs/vocabs.factor b/extra/tools/vocabs/vocabs.factor index d7e1070666..44a64cc9dd 100755 --- a/extra/tools/vocabs/vocabs.factor +++ b/extra/tools/vocabs/vocabs.factor @@ -108,6 +108,7 @@ MEMO: (vocab-file-contents) ( path -- lines ) : set-vocab-file-contents ( seq vocab name -- ) dupd vocab-append-path [ ?resource-path utf8 set-file-lines + \ (vocab-file-contents) reset-memoized ] [ "The " swap vocab-name " vocabulary was not loaded from the file system"