io.crlf: the lf>crlf and crlf>lf words looks generally useful, lets put them in io.crlf to reduce some code duplication
							parent
							
								
									36444f328f
								
							
						
					
					
						commit
						ba8caa72fb
					
				| 
						 | 
					@ -1,4 +1,4 @@
 | 
				
			||||||
USING: kernel furnace.actions validators tools.test math math.parser
 | 
					USING: kernel furnace.actions io.crlf validators tools.test math math.parser
 | 
				
			||||||
multiline namespaces http io.streams.string http.server http.server.requests
 | 
					multiline namespaces http io.streams.string http.server http.server.requests
 | 
				
			||||||
sequences splitting accessors ;
 | 
					sequences splitting accessors ;
 | 
				
			||||||
IN: furnace.actions.tests
 | 
					IN: furnace.actions.tests
 | 
				
			||||||
| 
						 | 
					@ -7,8 +7,6 @@ IN: furnace.actions.tests
 | 
				
			||||||
    [ "a" param "b" param [ string>number ] bi@ + ] >>display
 | 
					    [ "a" param "b" param [ string>number ] bi@ + ] >>display
 | 
				
			||||||
"action-1" set
 | 
					"action-1" set
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: lf>crlf ( string -- string' ) "\n" split "\r\n" join ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
STRING: action-request-test-1
 | 
					STRING: action-request-test-1
 | 
				
			||||||
GET http://foo/bar?a=12&b=13 HTTP/1.1
 | 
					GET http://foo/bar?a=12&b=13 HTTP/1.1
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,8 +1,8 @@
 | 
				
			||||||
USING: destructors http http.server http.server.requests http.client
 | 
					USING: destructors http http.server http.server.requests http.client
 | 
				
			||||||
http.client.private tools.test multiline fry io.streams.string io.encodings.utf8
 | 
					http.client.private tools.test multiline fry io.streams.string io.crlf
 | 
				
			||||||
io.encodings.8-bit io.encodings.binary io.encodings.string io.encodings.ascii
 | 
					io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.encodings.string
 | 
				
			||||||
kernel arrays splitting sequences assocs io.sockets db db.sqlite make
 | 
					io.encodings.ascii kernel arrays splitting sequences assocs io.sockets db
 | 
				
			||||||
continuations urls hashtables accessors namespaces xml.data
 | 
					db.sqlite make continuations urls hashtables accessors namespaces xml.data
 | 
				
			||||||
io.encodings.8-bit.latin1 random combinators.short-circuit ;
 | 
					io.encodings.8-bit.latin1 random combinators.short-circuit ;
 | 
				
			||||||
IN: http.tests
 | 
					IN: http.tests
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -25,8 +25,6 @@ IN: http.tests
 | 
				
			||||||
[ "localhost:8080" ] [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test
 | 
					[ "localhost:8080" ] [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test
 | 
				
			||||||
[ "localhost:8443" ] [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test
 | 
					[ "localhost:8443" ] [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: lf>crlf ( string -- string' ) "\n" split "\r\n" join ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
STRING: read-request-test-1
 | 
					STRING: read-request-test-1
 | 
				
			||||||
POST /bar HTTP/1.1
 | 
					POST /bar HTTP/1.1
 | 
				
			||||||
Some-Header: 1
 | 
					Some-Header: 1
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,11 +1,9 @@
 | 
				
			||||||
USING: accessors assocs continuations http http.client http.client.private
 | 
					USING: accessors assocs continuations http http.client http.client.private
 | 
				
			||||||
http.server http.server.requests io.streams.limited io.streams.string kernel
 | 
					http.server http.server.requests io.crlf io.streams.limited io.streams.string
 | 
				
			||||||
math math.parser multiline namespaces peg sequences splitting tools.test urls ;
 | 
					kernel math math.parser multiline namespaces peg sequences splitting
 | 
				
			||||||
 | 
					tools.test urls ;
 | 
				
			||||||
IN: http.server.requests.tests
 | 
					IN: http.server.requests.tests
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: normalize-nl ( str -- str' )
 | 
					 | 
				
			||||||
    "\n" "\r\n" replace ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: request>string ( request -- string )
 | 
					: request>string ( request -- string )
 | 
				
			||||||
    [ write-request ] with-string-writer ;
 | 
					    [ write-request ] with-string-writer ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -59,7 +57,7 @@ hello
 | 
				
			||||||
          "form-data; name=\"text\"; filename=\"upload.txt\"" }
 | 
					          "form-data; name=\"text\"; filename=\"upload.txt\"" }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
} [
 | 
					} [
 | 
				
			||||||
    test-multipart/form-data normalize-nl string>request
 | 
					    test-multipart/form-data lf>crlf string>request
 | 
				
			||||||
    post-data>> params>> "text" of [ filename>> ] [ headers>> ] bi
 | 
					    post-data>> params>> "text" of [ filename>> ] [ headers>> ] bi
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -142,8 +140,7 @@ hello
 | 
				
			||||||
        { redirects 10 }
 | 
					        { redirects 10 }
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
] [
 | 
					] [
 | 
				
			||||||
    "\r\n\r\n\r\nGET / HTTP/1.0\r\n\r\n"
 | 
					    "\r\n\r\n\r\nGET / HTTP/1.0\r\n\r\n" [ read-request ] with-string-reader
 | 
				
			||||||
    [ read-request ] with-string-reader
 | 
					 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! RFC 2616: Section 19.3
 | 
					! RFC 2616: Section 19.3
 | 
				
			||||||
| 
						 | 
					@ -157,5 +154,5 @@ hello
 | 
				
			||||||
        "host: 127.0.0.1:55532"
 | 
					        "host: 127.0.0.1:55532"
 | 
				
			||||||
        "user-agent: Factor http.client"
 | 
					        "user-agent: Factor http.client"
 | 
				
			||||||
    } [ "\n" join ] [ "\r\n" join ] bi
 | 
					    } [ "\n" join ] [ "\r\n" join ] bi
 | 
				
			||||||
    [ [ read-request ] with-string-reader ] same?
 | 
					    [ string>request ] same?
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -11,3 +11,6 @@ USING: io.crlf tools.test io.streams.string io ;
 | 
				
			||||||
[ f ] [ "" [ read-?crlf ] with-string-reader ] unit-test
 | 
					[ f ] [ "" [ read-?crlf ] with-string-reader ] unit-test
 | 
				
			||||||
[ "" ] [ "\n" [ read-?crlf ] with-string-reader ] unit-test
 | 
					[ "" ] [ "\n" [ read-?crlf ] with-string-reader ] unit-test
 | 
				
			||||||
[ "foo" ] [ "foo\n" [ read-?crlf ] with-string-reader ] unit-test
 | 
					[ "foo" ] [ "foo\n" [ read-?crlf ] with-string-reader ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ "foo\nbar" ] [ "foo\n\rbar" crlf>lf ] unit-test
 | 
				
			||||||
 | 
					[ "foo\r\nbar" ] [ "foo\nbar" lf>crlf ] unit-test
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,6 +1,6 @@
 | 
				
			||||||
! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
 | 
					! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: io kernel sequences ;
 | 
					USING: io kernel sequences splitting ;
 | 
				
			||||||
IN: io.crlf
 | 
					IN: io.crlf
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: crlf ( -- )
 | 
					: crlf ( -- )
 | 
				
			||||||
| 
						 | 
					@ -13,3 +13,9 @@ IN: io.crlf
 | 
				
			||||||
: read-?crlf ( -- seq )
 | 
					: read-?crlf ( -- seq )
 | 
				
			||||||
    "\r\n" read-until
 | 
					    "\r\n" read-until
 | 
				
			||||||
    [ CHAR: \r = [ read1 CHAR: \n assert= ] when ] [ f like ] if* ;
 | 
					    [ CHAR: \r = [ read1 CHAR: \n assert= ] when ] [ f like ] if* ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: crlf>lf ( str -- str' )
 | 
				
			||||||
 | 
					    CHAR: \r swap remove ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: lf>crlf ( str -- str' )
 | 
				
			||||||
 | 
					    "\n" split "\r\n" join ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -10,7 +10,7 @@ windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
 | 
				
			||||||
windows.messages windows.types windows.offscreen windows threads
 | 
					windows.messages windows.types windows.offscreen windows threads
 | 
				
			||||||
libc combinators fry combinators.short-circuit continuations
 | 
					libc combinators fry combinators.short-circuit continuations
 | 
				
			||||||
command-line shuffle opengl ui.render math.bitwise locals
 | 
					command-line shuffle opengl ui.render math.bitwise locals
 | 
				
			||||||
accessors math.rectangles math.order calendar ascii sets
 | 
					accessors math.rectangles math.order calendar ascii sets io.crlf
 | 
				
			||||||
io.encodings.utf16n windows.errors literals ui.pixel-formats
 | 
					io.encodings.utf16n windows.errors literals ui.pixel-formats
 | 
				
			||||||
ui.pixel-formats.private memoize classes colors
 | 
					ui.pixel-formats.private memoize classes colors
 | 
				
			||||||
specialized-arrays classes.struct ;
 | 
					specialized-arrays classes.struct ;
 | 
				
			||||||
| 
						 | 
					@ -172,12 +172,6 @@ PRIVATE>
 | 
				
			||||||
: GET_APPCOMMAND_LPARAM ( lParam -- appCommand )
 | 
					: GET_APPCOMMAND_LPARAM ( lParam -- appCommand )
 | 
				
			||||||
    hi-word FAPPCOMMAND_MASK lo-word bitnot bitand ; inline
 | 
					    hi-word FAPPCOMMAND_MASK lo-word bitnot bitand ; inline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: crlf>lf ( str -- str' )
 | 
					 | 
				
			||||||
    CHAR: \r swap remove ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: lf>crlf ( str -- str' )
 | 
					 | 
				
			||||||
    [ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: enum-clipboard ( -- seq )
 | 
					: enum-clipboard ( -- seq )
 | 
				
			||||||
    0
 | 
					    0
 | 
				
			||||||
    [ EnumClipboardFormats win32-error dup dup 0 > ]
 | 
					    [ EnumClipboardFormats win32-error dup dup 0 > ]
 | 
				
			||||||
| 
						 | 
					@ -209,7 +203,7 @@ PRIVATE>
 | 
				
			||||||
        EmptyClipboard win32-error=0/f
 | 
					        EmptyClipboard win32-error=0/f
 | 
				
			||||||
        GMEM_MOVEABLE over length 1 + GlobalAlloc
 | 
					        GMEM_MOVEABLE over length 1 + GlobalAlloc
 | 
				
			||||||
            dup win32-error=0/f
 | 
					            dup win32-error=0/f
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
        dup GlobalLock dup win32-error=0/f
 | 
					        dup GlobalLock dup win32-error=0/f
 | 
				
			||||||
        rot binary-object memcpy
 | 
					        rot binary-object memcpy
 | 
				
			||||||
        dup GlobalUnlock win32-error=0/f
 | 
					        dup GlobalUnlock win32-error=0/f
 | 
				
			||||||
| 
						 | 
					@ -506,7 +500,7 @@ SYMBOL: nc-buttons
 | 
				
			||||||
        { APPCOMMAND_BROWSER_FORWARD [ pick window right-action send-action ] }
 | 
					        { APPCOMMAND_BROWSER_FORWARD [ pick window right-action send-action ] }
 | 
				
			||||||
        [ drop ]
 | 
					        [ drop ]
 | 
				
			||||||
    } case 3drop ;
 | 
					    } case 3drop ;
 | 
				
			||||||
    
 | 
					
 | 
				
			||||||
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
 | 
					: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
 | 
				
			||||||
    [
 | 
					    [
 | 
				
			||||||
        over set-capture
 | 
					        over set-capture
 | 
				
			||||||
| 
						 | 
					@ -542,7 +536,7 @@ SYMBOL: nc-buttons
 | 
				
			||||||
    4drop release-capture ;
 | 
					    4drop release-capture ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: handle-wm-mouseleave ( hWnd uMsg wParam lParam -- )
 | 
					: handle-wm-mouseleave ( hWnd uMsg wParam lParam -- )
 | 
				
			||||||
    #! message sent if mouse leaves main application 
 | 
					    #! message sent if mouse leaves main application
 | 
				
			||||||
    4drop forget-rollover ;
 | 
					    4drop forget-rollover ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: system-background-color ( -- color )
 | 
					: system-background-color ( -- color )
 | 
				
			||||||
| 
						 | 
					@ -868,4 +862,3 @@ M: windows-ui-backend ui-backend-available?
 | 
				
			||||||
    t ;
 | 
					    t ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
windows-ui-backend ui-backend set-global
 | 
					windows-ui-backend ui-backend set-global
 | 
				
			||||||
 | 
					 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue