Rename from-now to hence
parent
3b2f4d92d2
commit
75338b577c
|
@ -10,7 +10,7 @@ HELP: add-alarm
|
||||||
|
|
||||||
HELP: later
|
HELP: later
|
||||||
{ $values { "quot" quotation } { "dt" duration } { "alarm" alarm } }
|
{ $values { "quot" quotation } { "dt" duration } { "alarm" alarm } }
|
||||||
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } { $link from-now } "." } ;
|
{ $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;
|
||||||
|
|
||||||
HELP: cancel-alarm
|
HELP: cancel-alarm
|
||||||
{ $values { "alarm" alarm } }
|
{ $values { "alarm" alarm } }
|
||||||
|
|
|
@ -82,10 +82,10 @@ PRIVATE>
|
||||||
<alarm> [ register-alarm ] keep ;
|
<alarm> [ register-alarm ] keep ;
|
||||||
|
|
||||||
: later ( quot dt -- alarm )
|
: later ( quot dt -- alarm )
|
||||||
from-now f add-alarm ;
|
hence f add-alarm ;
|
||||||
|
|
||||||
: every ( quot dt -- alarm )
|
: every ( quot dt -- alarm )
|
||||||
[ from-now ] keep add-alarm ;
|
[ hence ] keep add-alarm ;
|
||||||
|
|
||||||
: cancel-alarm ( alarm -- )
|
: cancel-alarm ( alarm -- )
|
||||||
alarm-entry [ alarms get-global heap-delete ] if-box? ;
|
alarm-entry [ alarms get-global heap-delete ] if-box? ;
|
||||||
|
|
|
@ -284,7 +284,7 @@ MEMO: unix-1970 ( -- timestamp )
|
||||||
|
|
||||||
: now ( -- timestamp ) gmt >local-time ;
|
: now ( -- timestamp ) gmt >local-time ;
|
||||||
|
|
||||||
: from-now ( dt -- timestamp ) now swap time+ ;
|
: hence ( dt -- timestamp ) now swap time+ ;
|
||||||
: ago ( dt -- timestamp ) now swap time- ;
|
: ago ( dt -- timestamp ) now swap time- ;
|
||||||
|
|
||||||
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
|
: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
|
||||||
|
@ -357,7 +357,7 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
|
||||||
|
|
||||||
M: timestamp sleep-until timestamp>millis sleep-until ;
|
M: timestamp sleep-until timestamp>millis sleep-until ;
|
||||||
|
|
||||||
M: duration sleep from-now sleep-until ;
|
M: duration sleep hence sleep-until ;
|
||||||
|
|
||||||
{
|
{
|
||||||
{ [ os unix? ] [ "calendar.unix" ] }
|
{ [ os unix? ] [ "calendar.unix" ] }
|
||||||
|
|
|
@ -40,10 +40,9 @@ M: login-realm modify-form ( responder -- )
|
||||||
permit-id get realm get name>> permit-id-key <cookie>
|
permit-id get realm get name>> permit-id-key <cookie>
|
||||||
"$login-realm" resolve-base-path >>path
|
"$login-realm" resolve-base-path >>path
|
||||||
realm get
|
realm get
|
||||||
[ timeout>> from-now >>expires ]
|
|
||||||
[ domain>> >>domain ]
|
[ domain>> >>domain ]
|
||||||
[ secure>> >>secure ]
|
[ secure>> >>secure ]
|
||||||
tri ;
|
bi ;
|
||||||
|
|
||||||
: put-permit-cookie ( response -- response' )
|
: put-permit-cookie ( response -- response' )
|
||||||
<permit-cookie> put-cookie ;
|
<permit-cookie> put-cookie ;
|
||||||
|
|
|
@ -33,4 +33,4 @@ TUPLE: server-state-manager < filter-responder timeout ;
|
||||||
20 minutes >>timeout ; inline
|
20 minutes >>timeout ; inline
|
||||||
|
|
||||||
: touch-state ( state manager -- )
|
: touch-state ( state manager -- )
|
||||||
timeout>> from-now >>expires drop ;
|
timeout>> hence >>expires drop ;
|
||||||
|
|
|
@ -116,7 +116,6 @@ M: session-saver dispose
|
||||||
: <session-cookie> ( -- cookie )
|
: <session-cookie> ( -- cookie )
|
||||||
session get id>> session-id-key <cookie>
|
session get id>> session-id-key <cookie>
|
||||||
"$sessions" resolve-base-path >>path
|
"$sessions" resolve-base-path >>path
|
||||||
sessions get timeout>> from-now >>expires
|
|
||||||
sessions get domain>> >>domain ;
|
sessions get domain>> >>domain ;
|
||||||
|
|
||||||
: put-session-cookie ( response -- response' )
|
: put-session-cookie ( response -- response' )
|
||||||
|
|
|
@ -45,7 +45,7 @@ tetris-gadget H{
|
||||||
dup tetris-gadget-tetris maybe-update relayout-1 ;
|
dup tetris-gadget-tetris maybe-update relayout-1 ;
|
||||||
|
|
||||||
M: tetris-gadget graft* ( gadget -- )
|
M: tetris-gadget graft* ( gadget -- )
|
||||||
dup [ tick ] curry 100 milliseconds from-now 100 milliseconds add-alarm
|
dup [ tick ] curry 100 milliseconds every
|
||||||
swap set-tetris-gadget-alarm ;
|
swap set-tetris-gadget-alarm ;
|
||||||
|
|
||||||
M: tetris-gadget ungraft* ( gadget -- )
|
M: tetris-gadget ungraft* ( gadget -- )
|
||||||
|
|
|
@ -121,7 +121,7 @@ SYMBOL: drag-timer
|
||||||
: start-drag-timer ( -- )
|
: start-drag-timer ( -- )
|
||||||
hand-buttons get-global empty? [
|
hand-buttons get-global empty? [
|
||||||
[ drag-gesture ]
|
[ drag-gesture ]
|
||||||
300 milliseconds from-now
|
300 milliseconds hence
|
||||||
100 milliseconds
|
100 milliseconds
|
||||||
add-alarm drag-timer get-global >box
|
add-alarm drag-timer get-global >box
|
||||||
] when ;
|
] when ;
|
||||||
|
|
Loading…
Reference in New Issue