Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-09-01 18:34:33 -05:00
commit ffc996d09a
28 changed files with 246 additions and 59 deletions

View File

@ -1 +0,0 @@
Doug Coleman

View File

@ -1,4 +0,0 @@
USING: kernel system ;
IN: calendar.backend
HOOK: gmt-offset os ( -- hours minutes seconds )

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math strings help.markup help.syntax
calendar.backend math.order ;
math.order ;
IN: calendar
HELP: duration
@ -278,8 +278,6 @@ HELP: time-
}
} ;
{ time+ time- } related-words
HELP: convert-timezone
{ $values { "timestamp" timestamp } { "duration" duration } { "timestamp" timestamp } }
{ $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." }
@ -299,3 +297,197 @@ HELP: >local-time
"t"
}
} ;
HELP: >gmt
{ $values { "timestamp" timestamp } { "timestamp" timestamp } }
{ $description "Converts the " { $snippet "timestamp" } " to the GMT timezone." }
{ $examples
{ $example "USING: accessors calendar kernel prettyprint ;"
"now >gmt gmt-offset>> hour>> ."
"0"
}
} ;
HELP: time*
{ $values { "obj1" object } { "obj2" object } { "obj3" object } }
{ $description "Multiplies each time slot of a timestamp or duration by a number and make a new duration from the result. Used in the implementation of " { $link before } "." } ;
{ time+ time- time* } related-words
HELP: before
{ $values { "duration" duration } { "-duration" duration } }
{ $description "Negates a duration." }
{ $examples
{ $example "USING: accessors calendar prettyprint ;"
"3 hours before now noon time+ hour>> ."
"9"
}
} ;
HELP: <zero>
{ $values { "timestamp" timestamp } }
{ $description "Outputs a zero timestamp that consists of zeros for every slot. Used to see if timestamps are valid." } ;
HELP: valid-timestamp?
{ $values { "timestamp" timestamp } { "?" "a boolean" } }
{ $description "Tests if a timestamp is valid or not." } ;
HELP: unix-1970
{ $values { "timestamp" timestamp } }
{ $description "Outputs the beginning of UNIX time, or midnight, January 1, 1970." } ;
HELP: millis>timestamp
{ $values { "x" number } { "timestamp" timestamp } }
{ $description "Converts a number of milliseconds into a timestamp value in GMT time." }
{ $examples
{ $example "USING: accessors calendar prettyprint ;"
"1000 millis>timestamp year>> ."
"1970"
}
} ;
HELP: gmt
{ $values { "timestamp" timestamp } }
{ $description "Outputs the time right now, but in the GMT timezone." } ;
{ gmt now } related-words
HELP: now
{ $values { "timestamp" timestamp } }
{ $description "Outputs the time right now in your computer's timezone." }
{ $examples
{ $unchecked-example "USING: calendar prettyprint ;"
"now ."
"T{ timestamp f 2008 9 1 16 38 24+801/1000 T{ duration f 0 0 0 -5 0 0 } }"
}
} ;
HELP: hence
{ $values { "duration" duration } { "timestamp" timestamp } }
{ $description "Computes a time in the future that is the " { $snippet "duration" } " added to the result of " { $link now } "." }
{ $examples
{ $unchecked-example
"USING: calendar prettyprint ;"
"10 hours hence ."
"T{ timestamp f 2008 9 2 2 47 45+943/1000 T{ duration f 0 0 0 -5 0 0 } }"
}
} ;
HELP: ago
{ $values { "duration" duration } { "timestamp" timestamp } }
{ $description "Computes a time in the past that is the " { $snippet "duration" } " subtracted from the result of " { $link now } "." }
{ $examples
{ $unchecked-example
"USING: calendar prettyprint ;"
"3 weeks ago ."
"T{ timestamp f 2008 8 11 16 49 52+99/500 T{ duration f 0 0 0 -5 0 0 } }"
}
} ;
HELP: zeller-congruence
{ $values { "year" integer } { "month" integer } { "day" integer } { "n" integer } }
{ $description "An implementation of an algorithm that computes the day of the week given a date. Days are indexed starting from Sunday, which is index 0." }
{ $notes "User code should use the " { $link day-of-week } " word, which takes a " { $snippet "timestamp" } " instead of integers." } ;
HELP: days-in-year
{ $values { "obj" "a timestamp or an integer" } { "n" integer } }
{ $description "Calculates the number of days in a given year." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"2004 days-in-year ."
"366"
}
} ;
HELP: days-in-month
{ $values { "timestamp" timestamp } { "n" integer } }
{ $description "Calculates the number of days in a given month." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"2008 8 24 <date> days-in-month ."
"31"
}
} ;
HELP: day-of-week
{ $values { "timestamp" timestamp } { "n" integer } }
{ $description "Calculates the index of the day of the week. Sunday will result in an index of 0." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"now sunday day-of-week ."
"0"
}
} ;
HELP: day-of-year
{ $values { "timestamp" timestamp } { "n" integer } }
{ $description "Calculates the day of the year, resulting in a number from 1 to 366 (leap years)." }
{ $examples
{ $example "USING: calendar prettyprint ;"
"2008 1 4 <date> day-of-year ."
"4"
}
} ;
HELP: day-this-week
{ $values { "timestamp" timestamp } { "n" integer } { "timestamp" timestamp } }
{ $description "Implementation word to calculate the day of the week relative to the timestamp. Sunday is the first day of the week, so the resulting " { $snippet "timestamp" } " will be Sunday or after, and before Saturday." }
{ $examples
{ $example "USING: calendar kernel prettyprint ;"
"now 0 day-this-week now sunday = ."
"t"
}
} ;
HELP: sunday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Sunday from the current week, which starts on a Sunday." } ;
HELP: monday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Monday from the current week, which starts on a Sunday." } ;
HELP: tuesday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Tuesday from the current week, which starts on a Sunday." } ;
HELP: wednesday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Wednesday from the current week, which starts on a Sunday." } ;
HELP: thursday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Thursday from the current week, which starts on a Sunday." } ;
HELP: friday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Friday from the current week, which starts on a Sunday." } ;
HELP: saturday
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns the Saturday from the current week, which starts on a Sunday." } ;
{ sunday monday tuesday wednesday thursday friday saturday } related-words
HELP: midnight
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns a timestamp that represents today at midnight, or the beginning of the day." } ;
HELP: noon
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Returns a timestamp that represents today at noon, or the middle of the day." } ;
HELP: beginning-of-month
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Outputs a timestamp with the day set to one." } ;
HELP: beginning-of-week
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Outputs a timestamp where the day of the week is Sunday." } ;
HELP: beginning-of-year
{ $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
{ $description "Outputs a timestamp with the month and day set to one, or January 1 of the input timestamp." } ;
HELP: time-since-midnight
{ $values { "timestamp" timestamp } { "duration" duration } }
{ $description "Calculates a " { $snippet "duration" } " that represents the elapsed time since midnight of the input " { $snippet "timestamp" } "." } ;

View File

@ -1,11 +1,13 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.functions namespaces sequences
strings system vocabs.loader calendar.backend threads
accessors combinators locals classes.tuple math.order
memoize summary combinators.short-circuit ;
strings system vocabs.loader threads accessors combinators
locals classes.tuple math.order summary
combinators.short-circuit ;
IN: calendar
HOOK: gmt-offset os ( -- hours minutes seconds )
TUPLE: duration
{ year real }
{ month real }
@ -304,17 +306,17 @@ M: timestamp time-
M: duration time-
before time+ ;
MEMO: <zero> ( -- timestamp )
0 0 0 0 0 0 instant <timestamp> ;
: <zero> ( -- timestamp )
0 0 0 0 0 0 instant <timestamp> ;
: valid-timestamp? ( timestamp -- ? )
clone instant >>gmt-offset
dup <zero> time- <zero> time+ = ;
MEMO: unix-1970 ( -- timestamp )
: unix-1970 ( -- timestamp )
1970 1 1 0 0 0 instant <timestamp> ;
: millis>timestamp ( n -- timestamp )
: millis>timestamp ( x -- timestamp )
>r unix-1970 r> milliseconds time+ ;
: timestamp>millis ( timestamp -- n )
@ -368,13 +370,13 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
: day-this-week ( timestamp n -- timestamp )
day-offset days time+ ;
: sunday ( timestamp -- timestamp ) 0 day-this-week ;
: monday ( timestamp -- timestamp ) 1 day-this-week ;
: tuesday ( timestamp -- timestamp ) 2 day-this-week ;
: wednesday ( timestamp -- timestamp ) 3 day-this-week ;
: thursday ( timestamp -- timestamp ) 4 day-this-week ;
: friday ( timestamp -- timestamp ) 5 day-this-week ;
: saturday ( timestamp -- timestamp ) 6 day-this-week ;
: sunday ( timestamp -- new-timestamp ) 0 day-this-week ;
: monday ( timestamp -- new-timestamp ) 1 day-this-week ;
: tuesday ( timestamp -- new-timestamp ) 2 day-this-week ;
: wednesday ( timestamp -- new-timestamp ) 3 day-this-week ;
: thursday ( timestamp -- new-timestamp ) 4 day-this-week ;
: friday ( timestamp -- new-timestamp ) 5 day-this-week ;
: saturday ( timestamp -- new-timestamp ) 6 day-this-week ;
: midnight ( timestamp -- new-timestamp )
clone 0 >>hour 0 >>minute 0 >>second ; inline

View File

@ -1,5 +1,5 @@
USING: alien alien.c-types arrays calendar.backend
kernel structs math unix.time namespaces system ;
USING: alien alien.c-types arrays calendar kernel structs
math unix.time namespaces system ;
IN: calendar.unix
: get-time ( -- alien )

View File

@ -1,5 +1,5 @@
USING: calendar.backend namespaces alien.c-types system
windows windows.kernel32 kernel math combinators ;
USING: calendar namespaces alien.c-types system windows
windows.kernel32 kernel math combinators ;
IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds )

View File

@ -1 +0,0 @@
Doug Coleman

View File

@ -1,4 +0,0 @@
USING: io.backend ;
IN: editors.gvim.backend
HOOK: gvim-path io-backend ( -- path )

View File

@ -1 +0,0 @@
unportable

View File

@ -1,10 +1,12 @@
USING: io.backend io.files kernel math math.parser
namespaces sequences system combinators
editors.vim editors.gvim.backend vocabs.loader ;
editors.vim vocabs.loader ;
IN: editors.gvim
SINGLETON: gvim
HOOK: gvim-path io-backend ( -- path )
M: gvim vim-command ( file line -- string )
[ gvim-path , swap , "+" swap number>string append , ] { } make ;

View File

@ -1,4 +1,4 @@
USING: io.unix.backend kernel namespaces editors.gvim.backend
USING: io.unix.backend kernel namespaces editors.gvim
system ;
IN: editors.gvim.unix

View File

@ -1,4 +1,4 @@
USING: editors.gvim.backend io.files io.windows kernel namespaces
USING: editors.gvim io.files io.windows kernel namespaces
sequences windows.shell32 io.paths system ;
IN: editors.gvim.windows

View File

@ -4,7 +4,7 @@ sequences tools.test namespaces byte-arrays strings accessors
destructors ;
: buffer-set ( string buffer -- )
over >byte-array over buffer-ptr byte-array>memory
over >byte-array over ptr>> byte-array>memory
>r length r> buffer-reset ;
: string>buffer ( string -- buffer )

View File

@ -60,10 +60,10 @@ M: gadget draw-selection ( loc gadget -- )
swap offset-rect [ rect-extent gl-fill-rect ] if-fits ;
M: node draw-selection ( loc node -- )
2dup node-value swap offset-rect [
2dup value>> swap offset-rect [
drop 2dup
[ node-value rect-loc v+ ] keep
node-children [ draw-selection ] with each
[ value>> rect-loc v+ ] keep
children>> [ draw-selection ] with each
] if-fits 2drop ;
M: pane draw-gadget*

View File

@ -1,9 +1,11 @@
IN: ui.traverse.tests
USING: ui.gadgets ui.gadgets.labels namespaces sequences kernel
USING: accessors ui.gadgets ui.gadgets.labels namespaces sequences kernel
math arrays tools.test io ui.gadgets.panes ui.traverse
definitions compiler.units ;
M: array gadget-children ;
IN: ui.traverse.tests
M: array children>> ;
GENERIC: (flatten-tree) ( node -- )

View File

@ -77,7 +77,7 @@ DEFER: (gadget-subtree)
[ (gadget-subtree) ] { } make ;
M: node gadget-text*
dup node-children swap node-value gadget-seq-text ;
dup children>> swap value>> gadget-seq-text ;
: gadget-text-range ( frompath topath gadget -- str )
gadget-subtree gadget-text ;

View File

@ -69,7 +69,7 @@ M: world configure-event
: key-down-event>gesture ( event world -- string gesture )
dupd
handle>> x11-handle-xic lookup-string
handle>> xic>> lookup-string
>r swap event-modifiers r> key-code <key-down> ;
M: world key-down-event
@ -116,14 +116,14 @@ M: world motion-event
M: world focus-in-event
nip
dup handle>> x11-handle-xic XSetICFocus focus-world ;
dup handle>> xic>> XSetICFocus focus-world ;
M: world focus-out-event
nip
dup handle>> x11-handle-xic XUnsetICFocus unfocus-world ;
dup handle>> xic>> XUnsetICFocus unfocus-world ;
M: world selection-notify-event
[ handle>> x11-handle-window selection-from-event ] keep
[ handle>> window>> selection-from-event ] keep
world-focus user-input ;
: supported-type? ( atom -- ? )
@ -161,9 +161,9 @@ M: world selection-request-event
} cond ;
M: x11-ui-backend (close-window) ( handle -- )
dup x11-handle-xic XDestroyIC
dup x11-handle-glx destroy-glx
x11-handle-window dup unregister-window
dup xic>> XDestroyIC
dup glx>> destroy-glx
window>> dup unregister-window
destroy-window ;
M: world client-event
@ -172,7 +172,7 @@ M: world client-event
: gadget-window ( world -- )
dup window-loc>> over rect-dim glx-window
over "Factor" create-xic <x11-handle>
2dup x11-handle-window register-window
2dup window>> register-window
swap (>>handle) ;
: wait-event ( -- event )
@ -189,14 +189,14 @@ M: x11-ui-backend do-events
: x-clipboard@ ( gadget clipboard -- prop win )
x-clipboard-atom swap
find-world handle>> x11-handle-window ;
find-world handle>> window>> ;
M: x-clipboard copy-clipboard
[ x-clipboard@ own-selection ] keep
set-x-clipboard-contents ;
M: x-clipboard paste-clipboard
>r find-world handle>> x11-handle-window
>r find-world handle>> window>>
r> x-clipboard-atom convert-selection ;
: init-clipboard ( -- )
@ -212,11 +212,11 @@ M: x-clipboard paste-clipboard
r> utf8 encode dup length XChangeProperty drop ;
M: x11-ui-backend set-title ( string world -- )
handle>> x11-handle-window swap dpy get -rot
handle>> window>> swap dpy get -rot
3dup set-title-old set-title-new ;
M: x11-ui-backend set-fullscreen* ( ? world -- )
handle>> x11-handle-window "XClientMessageEvent" <c-object>
handle>> window>> "XClientMessageEvent" <c-object>
tuck set-XClientMessageEvent-window
swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
over set-XClientMessageEvent-data0
@ -230,20 +230,20 @@ M: x11-ui-backend set-fullscreen* ( ? world -- )
M: x11-ui-backend (open-window) ( world -- )
dup gadget-window
handle>> x11-handle-window dup set-closable map-window ;
handle>> window>> dup set-closable map-window ;
M: x11-ui-backend raise-window* ( world -- )
handle>> [
dpy get swap x11-handle-window XRaiseWindow drop
dpy get swap window>> XRaiseWindow drop
] when* ;
M: x11-ui-backend select-gl-context ( handle -- )
dpy get swap
dup x11-handle-window swap x11-handle-glx glXMakeCurrent
dup window>> swap glx>> glXMakeCurrent
[ "Failed to set current GLX context" throw ] unless ;
M: x11-ui-backend flush-gl-context ( handle -- )
dpy get swap x11-handle-window glXSwapBuffers ;
dpy get swap window>> glXSwapBuffers ;
M: x11-ui-backend ui ( -- )
[