fix stack effects/formatting in contrib files
parent
cb2a7e9ac5
commit
90d8b67ff0
|
@ -25,25 +25,25 @@ USING: sequences kernel parser math namespaces io ;
|
||||||
|
|
||||||
: get-text ( string -- remainder chunk )
|
: get-text ( string -- remainder chunk )
|
||||||
"<%" over start dup -1 = [
|
"<%" over start dup -1 = [
|
||||||
drop "" swap
|
drop "" swap
|
||||||
] [
|
] [
|
||||||
2dup head >r tail r>
|
2dup head >r tail r>
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: get-embedded ( "<%code%>blah" -- "blah" "code" )
|
: get-embedded ( string -- string code-string )
|
||||||
! regexps where art thou?
|
! regexps where art thou?
|
||||||
"%>" over 2 start* 2dup swap 2 -rot subseq >r 2 + tail r> ;
|
"%>" over 2 start* 2dup swap 2 -rot subseq >r 2 + tail r> ;
|
||||||
|
|
||||||
: get-first-chunk ( string -- string )
|
: get-first-chunk ( string -- string )
|
||||||
dup "<%" head? [
|
dup "<%" head? [
|
||||||
get-embedded parse %
|
get-embedded parse %
|
||||||
] [
|
] [
|
||||||
get-text , \ write ,
|
get-text , \ write ,
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: embedded>factor ( string -- )
|
: embedded>factor ( string -- )
|
||||||
dup length 0 > [
|
dup length 0 > [
|
||||||
get-first-chunk embedded>factor
|
get-first-chunk embedded>factor
|
||||||
] [ drop ] if ;
|
] [ drop ] if ;
|
||||||
|
|
||||||
: parse-embedded ( string -- quot )
|
: parse-embedded ( string -- quot )
|
||||||
|
|
|
@ -71,7 +71,7 @@ reset-callback-table
|
||||||
#! Tuple for holding data related to a callback.
|
#! Tuple for holding data related to a callback.
|
||||||
TUPLE: item quot expire? request id time-added ;
|
TUPLE: item quot expire? request id time-added ;
|
||||||
|
|
||||||
C: item ( quot data data-quot expire? id -- item )
|
C: item ( quot expire? request id -- item )
|
||||||
millis over set-item-time-added
|
millis over set-item-time-added
|
||||||
[ set-item-id ] keep
|
[ set-item-id ] keep
|
||||||
[ set-item-request ] keep
|
[ set-item-request ] keep
|
||||||
|
|
|
@ -55,7 +55,7 @@ SYMBOL: html
|
||||||
|
|
||||||
: write-html H{ { html t } } format ;
|
: write-html H{ { html t } } format ;
|
||||||
|
|
||||||
: html-word ( name def -- )
|
: html-word ( name def -- word )
|
||||||
#! Define 'word creating' word to allow
|
#! Define 'word creating' word to allow
|
||||||
#! dynamically creating words.
|
#! dynamically creating words.
|
||||||
>r "html" create dup r> define-compound ;
|
>r "html" create dup r> define-compound ;
|
||||||
|
|
|
@ -104,20 +104,17 @@ SYMBOL: responders
|
||||||
] make-hash add-responder ;
|
] make-hash add-responder ;
|
||||||
|
|
||||||
: make-responder ( quot -- responder )
|
: make-responder ( quot -- responder )
|
||||||
|
#! quot has stack effect ( url -- )
|
||||||
[
|
[
|
||||||
( url -- )
|
|
||||||
[
|
[
|
||||||
drop "GET method not implemented" httpd-error
|
drop "GET method not implemented" httpd-error
|
||||||
] "get" set
|
] "get" set
|
||||||
( url -- )
|
|
||||||
[
|
[
|
||||||
drop "POST method not implemented" httpd-error
|
drop "POST method not implemented" httpd-error
|
||||||
] "post" set
|
] "post" set
|
||||||
( url -- )
|
|
||||||
[
|
[
|
||||||
drop "HEAD method not implemented" httpd-error
|
drop "HEAD method not implemented" httpd-error
|
||||||
] "head" set
|
] "head" set
|
||||||
( url -- )
|
|
||||||
[
|
[
|
||||||
drop bad-request
|
drop bad-request
|
||||||
] "bad" set
|
] "bad" set
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
IN: vim
|
IN: vim
|
||||||
USING: definitions embedded io kernel parser prettyprint process
|
USING: definitions embedded io kernel namespaces parser prettyprint process
|
||||||
sequences namespaces ;
|
sequences ;
|
||||||
|
|
||||||
: vim-location ( file line -- )
|
: vim-location ( file line -- )
|
||||||
>r [ file-modified ] keep r>
|
>r [ file-modified ] keep r>
|
||||||
|
|
|
@ -67,7 +67,8 @@ M: xml-string-error error.
|
||||||
char "\n\r" member? [ 0 column set line ] [ column ] if
|
char "\n\r" member? [ 0 column set line ] [ column ] if
|
||||||
inc ;
|
inc ;
|
||||||
|
|
||||||
: skip-until ( quot -- | quot: char -- ? )
|
: skip-until ( quot -- )
|
||||||
|
#! quot: ( char -- ? )
|
||||||
more? [
|
more? [
|
||||||
char swap [ call ] keep swap [ drop ] [
|
char swap [ call ] keep swap [ drop ] [
|
||||||
incr-spot skip-until
|
incr-spot skip-until
|
||||||
|
@ -152,7 +153,8 @@ M: xml-string-error error.
|
||||||
|
|
||||||
! -- Parsing tags
|
! -- Parsing tags
|
||||||
|
|
||||||
: in-range-seq? ( number { { min max } ... } -- ? )
|
: in-range-seq? ( number seq -- ? )
|
||||||
|
#! seq: { { min max } { min max }* }
|
||||||
[ first2 between? ] contains-with? ;
|
[ first2 between? ] contains-with? ;
|
||||||
|
|
||||||
: name-start-char? ( ch -- ? )
|
: name-start-char? ( ch -- ? )
|
||||||
|
|
Loading…
Reference in New Issue