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

basis/calendar/calendar-docs.factor

@@ -322,3 +322,172 @@ HELP: before
                "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" } "." } ;

basis/calendar/calendar.factor

@@ -316,7 +316,7 @@ M: duration time-
 : 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 )
@@ -370,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

basis/io/buffers/buffers-tests.factor

@@ -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 )

basis/ui/x11/x11.factor

@@ -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 ( -- )
     [

basis/windows/time/time.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types kernel math windows windows.kernel32
-namespaces calendar calendar.backend ;
+namespaces calendar ;
 IN: windows.time
 
 : >64bit ( lo hi -- n )

basis/xml/errors/errors.factor

@@ -53,7 +53,7 @@ M: mismatched summary ( obj -- str )
 TUPLE: unclosed < parsing-error tags ;
 : <unclosed> ( -- unclosed )
     unclosed parsing-error
-        xml-stack get rest-slice [ first opener-name ] map >>tags ;
+        xml-stack get rest-slice [ first name>> ] map >>tags ;
 M: unclosed summary ( obj -- str )
     [
         dup call-next-method write

basis/xml/tokenize/tokenize.factor

@@ -49,7 +49,7 @@ SYMBOL: ns-stack
 ! Parsing names
 
 : version=1.0? ( -- ? )
-    prolog-data get prolog-version "1.0" = ;
+    prolog-data get version>> "1.0" = ;
 
 ! version=1.0? is calculated once and passed around for efficiency
 
@@ -69,7 +69,7 @@ SYMBOL: ns-stack
 
 : (parse-entity) ( string -- )
     dup entities at [ , ] [ 
-        prolog-data get prolog-standalone
+        prolog-data get standalone>>
         [ <no-entity> throw ] [
             dup extra-entities get at
             [ , ] [ <no-entity> throw ] ?if

extra/faq/faq.factor

@@ -18,15 +18,15 @@ C: <q/a> q/a
 : li>q/a ( li -- q/a )
     [ "br" tag-named*? not ] filter
     [ "strong" tag-named*? ] find-after
-    >r tag-children r> <q/a> ;
+    >r children>> r> <q/a> ;
 
 : q/a>li ( q/a -- li )
     [ question>> "strong" build-tag* f "br" build-tag* 2array ] keep
     answer>> append "li" build-tag* ;
 
 : xml>q/a ( xml -- q/a )
-    [ "question" tag-named tag-children ] keep
-    "answer" tag-named tag-children <q/a> ;
+    [ "question" tag-named children>> ] keep
+    "answer" tag-named children>> <q/a> ;
 
 : q/a>xml ( q/a -- xml )
     [ question>> "question" build-tag* ] keep
@@ -39,7 +39,7 @@ C: <question-list> question-list
 
 : xml>question-list ( list -- question-list )
     [ "title" swap at ] keep
-    tag-children [ tag? ] filter [ xml>q/a ] map
+    children>> [ tag? ] filter [ xml>q/a ] map
     <question-list> ;
 
 : question-list>xml ( question-list -- list )

extra/furnace/furnace.factor

@@ -176,7 +176,7 @@ CHLOE: a
                     [ link-attrs ]
                     [ "method" optional-attr "post" or =method ]
                     [ "action" required-attr resolve-base-path =action ]
-                    [ tag-attrs non-chloe-attrs-only print-attrs ]
+                    [ attrs>> non-chloe-attrs-only print-attrs ]
                 } cleave
             form>
         ]
@@ -196,13 +196,13 @@ STRING: button-tag-markup
 ;
 
 : add-tag-attrs ( attrs tag -- )
-    tag-attrs swap update ;
+    attrs>> swap update ;
 
 CHLOE: button
     button-tag-markup string>xml delegate
     {
-        [ [ tag-attrs chloe-attrs-only ] dip add-tag-attrs ]
-        [ [ tag-attrs non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
+        [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
+        [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
         [ [ children>string 1array ] dip "button" tag-named set-tag-children ]
         [ nip ]
     } 2cleave process-chloe-tag ;

extra/html/templates/chloe/chloe.factor

@@ -22,10 +22,10 @@ C: <chloe> chloe
 DEFER: process-template
 
 : chloe-attrs-only ( assoc -- assoc' )
-    [ drop name-url chloe-ns = ] assoc-filter ;
+    [ drop url>> chloe-ns = ] assoc-filter ;
 
 : non-chloe-attrs-only ( assoc -- assoc' )
-    [ drop name-url chloe-ns = not ] assoc-filter ;
+    [ drop url>> chloe-ns = not ] assoc-filter ;
 
 : chloe-tag? ( tag -- ? )
     dup xml? [ body>> ] when
@@ -148,10 +148,10 @@ CHLOE-TUPLE: code
             process-template
         ] [
             {
-                [ xml-prolog write-prolog ]
-                [ xml-before write-chunk  ]
+                [ prolog>> write-prolog ]
+                [ before>> write-chunk  ]
                 [ process-template        ]
-                [ xml-after write-chunk   ]
+                [ after>> write-chunk   ]
             } cleave
         ] if
     ] with-scope ;

extra/springies/ui/ui.factor

@@ -10,7 +10,7 @@ IN: springies.ui
 : draw-node ( node -- ) pos>> { -5 -5 } v+ dup { 10 10 } v+ gl-rect ;
 
 : draw-spring ( spring -- )
-  [ spring-node-a pos>> ] [ spring-node-b pos>> ] bi gl-line ;
+  [ node-a>> pos>> ] [ node-b>> pos>> ] bi gl-line ;
 
 : draw-nodes ( -- ) nodes> [ draw-node ] each ;
 

extra/x/widgets/wm/workspace/workspace.factor

@@ -1,5 +1,6 @@
 
-USING: kernel namespaces namespaces.lib math sequences vars mortar slot-accessors x ;
+USING: kernel namespaces namespaces.lib math sequences vars mortar
+accessors slot-accessors x ;
 
 IN: x.widgets.wm.workspace
 
@@ -23,9 +24,9 @@ dpy get $default-root <- children [ <- mapped? ] filter ;
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : switch-to-workspace ( n -- )
-mapped-windows current-workspace> workspaces> nth set-workspace-windows
+mapped-windows current-workspace> workspaces> nth (>>windows)
 mapped-windows [ <- unmap drop ] each
-dup workspaces> nth workspace-windows [ <- map drop ] each
+dup workspaces> nth windows>> [ <- map drop ] each
 current-workspace set* ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!