Merge branch 'master' of git://factorcode.org/git/factor
commit
ffc996d09a
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
|
@ -1,4 +0,0 @@
|
|||
USING: kernel system ;
|
||||
IN: calendar.backend
|
||||
|
||||
HOOK: gmt-offset os ( -- hours minutes seconds )
|
|
@ -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" } "." } ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
|
@ -1,4 +0,0 @@
|
|||
USING: io.backend ;
|
||||
IN: editors.gvim.backend
|
||||
|
||||
HOOK: gvim-path io-backend ( -- path )
|
|
@ -1 +0,0 @@
|
|||
unportable
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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*
|
||||
|
|
|
@ -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 -- )
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ( -- )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue