From 7025ebd7ee5f856751af7b205195fd828e808f91 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 31 Aug 2008 20:19:16 -0500 Subject: [PATCH 1/6] docs --- basis/calendar/calendar-docs.factor | 68 ++++++++++++++++++++++++++++- basis/calendar/calendar.factor | 1 - 2 files changed, 67 insertions(+), 2 deletions(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index 2c23ae95c1..d3bfa7bcb1 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -184,7 +184,7 @@ HELP: time+ { $description "Adds two durations to produce a duration or adds a timestamp and a duration to produce a timestamp. The calculation takes timezones into account." } { $examples { $example "USING: calendar math.order prettyprint ;" - "10 months 2 months time+ 1 year <=> ." + "10 months 2 months time+ 1 years <=> ." "+eq+" } { $example "USING: accessors calendar math.order prettyprint ;" @@ -193,3 +193,69 @@ HELP: time+ } } ; +HELP: dt>years +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in years." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 months dt>years ." + "1/2" + } +} ; + +HELP: dt>months +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in months." } +{ $examples + { $example "USING: calendar prettyprint ;" + "30 days dt>months ." + "16000/16233" + } +} ; + +HELP: dt>days +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in days." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 hours dt>days ." + "1/4" + } +} ; + +HELP: dt>hours +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in hours." } +{ $examples + { $example "USING: calendar prettyprint ;" + "3/4 days dt>hours ." + "18" + } +} ; +HELP: dt>minutes +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in minutes." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 hours dt>minutes ." + "360" + } +} ; +HELP: dt>seconds +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in seconds." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 minutes dt>seconds ." + "360" + } +} ; +HELP: dt>milliseconds +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in milliseconds." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 seconds dt>milliseconds ." + "6000" + } +} ; diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index d9284573c4..36b3cf3250 100755 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -395,7 +395,6 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ; : time-since-midnight ( timestamp -- duration ) dup midnight time- ; - M: timestamp sleep-until timestamp>millis sleep-until ; M: duration sleep hence sleep-until ; From 261fc87dca04101790b2148ef8edd6df1fde9fda Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 31 Aug 2008 21:20:56 -0500 Subject: [PATCH 2/6] wtf instant was MEMO: oops. docs --- basis/calendar/calendar-docs.factor | 40 +++++++++++++++++++++++++++++ basis/calendar/calendar.factor | 9 +++---- 2 files changed, 44 insertions(+), 5 deletions(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index d3bfa7bcb1..8ee104d16e 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -250,6 +250,7 @@ HELP: dt>seconds "360" } } ; + HELP: dt>milliseconds { $values { "duration" duration } { "x" number } } { $description "Calculates the length of a duration in milliseconds." } @@ -259,3 +260,42 @@ HELP: dt>milliseconds "6000" } } ; + +{ dt>years dt>months dt>days dt>hours dt>minutes dt>seconds dt>milliseconds } related-words + + +HELP: time- +{ $values { "time1" "timestamp or duration" } { "time2" "timestamp or duration" } { "time3" "timestamp or duration" } } +{ $description "Subtracts two durations to produce a duration or subtracts a duration from a timestamp to produce a timestamp. The calculation takes timezones into account." } +{ $examples + { $example "USING: calendar math.order prettyprint ;" + "10 months 2 months time- 8 months <=> ." + "+eq+" + } + { $example "USING: accessors calendar math.order prettyprint ;" + "2010 1 1 3 days time- day>> ." + "29" + } +} ; + +{ 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" } "." } +{ $examples + { $example "USING: accessors calendar prettyprint ;" + "gmt noon instant -5 >>hour convert-timezone gmt-offset>> hour>> ." + "-5" + } +} ; + +HELP: >local-time +{ $values { "timestamp" timestamp } { "timestamp" timestamp } } +{ $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." } +{ $examples + { $example "USING: accessors calendar kernel prettyprint ;" + "now gmt >local-time [ gmt-offset>> ] bi@ = ." + "t" + } +} ; diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 36b3cf3250..ff002bb16c 100755 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -60,6 +60,8 @@ PRIVATE> : month-abbreviation ( n -- string ) check-month 1- month-abbreviations nth ; +: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline + : day-names ( -- array ) { "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" @@ -116,7 +118,7 @@ PRIVATE> : >time< ( timestamp -- hour minute second ) [ hour>> ] [ minute>> ] [ second>> ] tri ; -MEMO: instant ( -- duration ) 0 0 0 0 0 0 ; +: instant ( -- duration ) 0 0 0 0 0 0 ; : years ( x -- duration ) instant clone swap >>year ; : months ( x -- duration ) instant clone swap >>month ; : days ( x -- duration ) instant clone swap >>day ; @@ -258,7 +260,7 @@ M: duration <=> [ dt>years ] compare ; : dt>seconds ( duration -- x ) dt>years seconds-per-year * ; : dt>milliseconds ( duration -- x ) dt>seconds 1000 * ; -GENERIC: time- ( time1 time2 -- time ) +GENERIC: time- ( time1 time2 -- time3 ) : convert-timezone ( timestamp duration -- timestamp ) over gmt-offset>> over = [ drop ] [ @@ -323,12 +325,9 @@ MEMO: unix-1970 ( -- timestamp ) unix-1970 millis milliseconds time+ ; : now ( -- timestamp ) gmt >local-time ; - : hence ( duration -- timestamp ) now swap time+ ; : ago ( duration -- timestamp ) now swap time- ; -: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline - : zeller-congruence ( year month day -- n ) #! Zeller Congruence #! http://web.textfiles.com/computers/formulas.txt From 683993c94786155e363bd70b3e6ec17b60c2698f Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 31 Aug 2008 21:24:58 -0500 Subject: [PATCH 3/6] obj.view: Add workaround so that 'article-content' method doesn't call 'execute' --- extra/obj/view/view.factor | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/extra/obj/view/view.factor b/extra/obj/view/view.factor index 6b3249f057..cf5ca33745 100644 --- a/extra/obj/view/view.factor +++ b/extra/obj/view/view.factor @@ -40,7 +40,13 @@ PREDICATE: obj-list < word \ objects = ; M: obj-list article-title ( objects -- title ) drop "Objects" ; +! M: obj-list article-content ( objects -- title ) +! execute +! [ [ type -> ] [ ] bi 2array ] map +! { $tab , } bake ; + M: obj-list article-content ( objects -- title ) - execute + drop + objects [ [ type -> ] [ ] bi 2array ] map { $tab , } bake ; \ No newline at end of file From 768b97aa6660562e771e6aa7abf7a08d4375e4a9 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 31 Aug 2008 22:07:22 -0500 Subject: [PATCH 4/6] obj.examples.todo: Use the 'obj' system as a todo list --- extra/obj/examples/todo/todo.factor | 83 +++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 extra/obj/examples/todo/todo.factor diff --git a/extra/obj/examples/todo/todo.factor b/extra/obj/examples/todo/todo.factor new file mode 100644 index 0000000000..3d545479e9 --- /dev/null +++ b/extra/obj/examples/todo/todo.factor @@ -0,0 +1,83 @@ + +USING: kernel sequences sets combinators.cleave + obj obj.view obj.util obj.print ; + +IN: obj.examples.todo + +SYM: person types adjoin +SYM: todo types adjoin + +SYM: owners properties adjoin +SYM: eta properties adjoin +SYM: notes properties adjoin + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYM: slava { type person } define-object +SYM: doug { type person } define-object +SYM: ed { type person } define-object + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYM: compiler-bugs + { + type todo + owners { slava } + notes { + "Investitage FEP on Terrorist" + "Problem with cutler in VirtualBox?" + } + } +define-object + +SYM: remove-old-accessors-from-core + { + type todo + owners { slava } + } +define-object + +SYM: move-db-and-web-framework-to-basis + { + type todo + owners { slava } + } +define-object + +SYM: remove-old-accessors-from-basis + { + type todo + owners { doug ed } + } +define-object + +SYM: blas-on-bsd + { + type todo + owners { slava doug } + } +define-object + +SYM: multi-methods-backend + { + type todo + owners { slava } + } +define-object + +SYM: update-core-for-multi-methods { type todo owners { slava } } define-object +SYM: update-basis-for-multi-methods { type todo } define-object +SYM: update-extra-for-multi-methods { type todo } define-object + + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: todo-list ( -- ) + objects [ type -> todo = ] filter + [ { [ self -> ] [ owners -> ] [ eta -> ] } 1arr ] + map + { "ITEM" "OWNERS" "ETA" } prefix + print-table ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + From 401597a387add5b52111d1dd954d6250ee2b2688 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 31 Aug 2008 23:35:32 -0500 Subject: [PATCH 5/6] Update old accessors from 'ui.gestures' --- basis/ui/gestures/gestures-docs.factor | 18 +++++++++--------- basis/ui/gestures/gestures.factor | 16 ++++++++-------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor index bcf7eb5ca8..0575ff17f0 100644 --- a/basis/ui/gestures/gestures-docs.factor +++ b/basis/ui/gestures/gestures-docs.factor @@ -30,13 +30,13 @@ HELP: motion { $examples { $code "T{ motion }" } } ; HELP: drag -{ $class-description "Mouse drag gesture. The " { $link drag-# } " slot is either set to a mouse button number, or " { $link f } " indicating no specific button is expected." } ; +{ $class-description "Mouse drag gesture. The " { $snippet "#" } " slot is either set to a mouse button number, or " { $link f } " indicating no specific button is expected." } ; HELP: button-up { $class-description "Mouse button up gesture. Instances have two slots:" { $list - { { $link button-up-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } - { { $link button-up-# } " - a mouse button number, or " { $link f } " indicating no specific button is expected" } + { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } + { { $snippet "#" } " - a mouse button number, or " { $link f } " indicating no specific button is expected" } } } { $examples { $code "T{ button-up f f 1 }" "T{ button-up }" } } ; @@ -44,8 +44,8 @@ HELP: button-up HELP: button-down { $class-description "Mouse button down gesture. Instances have two slots:" { $list - { { $link button-down-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } - { { $link button-down-# } " - a mouse button number, or " { $link f } " indicating no specific button is expected" } + { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } + { { $snippet "#" } " - a mouse button number, or " { $link f } " indicating no specific button is expected" } } } { $examples { $code "T{ button-down f f 1 }" "T{ button-down }" } } ; @@ -109,8 +109,8 @@ HELP: S+ HELP: key-down { $class-description "Key down gesture. Instances have two slots:" { $list - { { $link key-down-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } - { { $link key-down-sym } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } } + { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } + { { $snippet "sym" } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } } } } { $examples { $code "T{ key-down f { C+ } \"a\" }" "T{ key-down f f \"TAB\" }" } } ; @@ -118,8 +118,8 @@ HELP: key-down HELP: key-up { $class-description "Key up gesture. Instances have two slots:" { $list - { { $link key-up-mods } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } - { { $link key-up-sym } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } } + { { $snippet "mods" } " - a sequence of modifiers; see " { $link "keyboard-gestures" } } + { { $snippet "sym" } " - a string denoting the key pressed; see " { $link "keyboard-gestures" } } } } { $examples { $code "T{ key-up f { C+ } \"a\" }" "T{ key-up f f \"TAB\" }" } } ; diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 95417ac71f..6b53d25ea1 100755 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -226,14 +226,14 @@ SYMBOL: drag-timer : send-button-down ( gesture loc world -- ) move-hand start-drag-timer - dup button-down-# + dup #>> dup update-click# hand-buttons get-global push update-clicked button-gesture ; : send-button-up ( gesture loc world -- ) move-hand - dup button-up-# hand-buttons get-global delete + dup #>> hand-buttons get-global delete stop-drag-timer button-gesture ; @@ -261,21 +261,21 @@ GENERIC: gesture>string ( gesture -- string/f ) [ name>> ] map concat >string ; M: key-down gesture>string - dup key-down-mods modifiers>string - swap key-down-sym append ; + dup mods>> modifiers>string + swap sym>> append ; M: button-up gesture>string [ - dup button-up-mods modifiers>string % + dup mods>> modifiers>string % "Click Button" % - button-up-# [ " " % # ] when* + #>> [ " " % # ] when* ] "" make ; M: button-down gesture>string [ - dup button-down-mods modifiers>string % + dup mods>> modifiers>string % "Press Button" % - button-down-# [ " " % # ] when* + #>> [ " " % # ] when* ] "" make ; M: left-action gesture>string drop "Swipe left" ; From 61e5729cdbbe2ea87d0e842e74aa4fe399b01caa Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Sun, 31 Aug 2008 23:53:07 -0500 Subject: [PATCH 6/6] Update old accessors from 'ui.operations' --- basis/ui/operations/operations-docs.factor | 12 ++++----- basis/ui/operations/operations.factor | 30 +++++++++++----------- basis/ui/tools/listener/listener.factor | 2 +- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/basis/ui/operations/operations-docs.factor b/basis/ui/operations/operations-docs.factor index 5f7ed60f38..ebdf3eee1f 100644 --- a/basis/ui/operations/operations-docs.factor +++ b/basis/ui/operations/operations-docs.factor @@ -22,11 +22,11 @@ HELP: operation $nl "Operations have the following slots:" { $list - { { $link operation-predicate } " - a quotation with stack effect " { $snippet "( obj -- ? )" } } - { { $link operation-command } " - a " { $link word } } - { { $link operation-translator } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } - { { $link operation-hook } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } - { { $link operation-listener? } " - a boolean" } + { { $snippet "predicate" } " - a quotation with stack effect " { $snippet "( obj -- ? )" } } + { { $snippet "command" } " - a " { $link word } } + { { $snippet "translator" } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } + { { $snippet "hook" } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } + { { $snippet "listener?" } " - a boolean" } } } ; HELP: operation-gesture @@ -38,7 +38,7 @@ HELP: operations HELP: object-operations { $values { "obj" object } { "operations" "a sequence of " { $link operation } " instances" } } -{ $description "Outputs a sequence of operations applicable to the given object, by testing each defined operation's " { $link operation-predicate } " quotation in turn." } ; +{ $description "Outputs a sequence of operations applicable to the given object, by testing each defined operation's " { $snippet "predicate" } " quotation in turn." } ; HELP: primary-operation { $values { "obj" object } { "operation" "an " { $link operation } " or " { $link f } } } diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor index 5a47f9e80b..8b4817dcac 100755 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -19,34 +19,34 @@ TUPLE: operation predicate command translator hook listener? ; swap >>predicate ; PREDICATE: listener-operation < operation - dup operation-command listener-command? - swap operation-listener? or ; + dup command>> listener-command? + swap listener?>> or ; M: operation command-name - operation-command command-name ; + command>> command-name ; M: operation command-description - operation-command command-description ; + command>> command-description ; -M: operation command-word operation-command command-word ; +M: operation command-word command>> command-word ; : operation-gesture ( operation -- gesture ) - operation-command +keyboard+ word-prop ; + command>> +keyboard+ word-prop ; SYMBOL: operations : object-operations ( obj -- operations ) - operations get [ operation-predicate call ] with filter ; + operations get [ predicate>> call ] with filter ; : find-operation ( obj quot -- command ) >r object-operations r> find-last nip ; inline : primary-operation ( obj -- operation ) - [ operation-command +primary+ word-prop ] find-operation ; + [ command>> +primary+ word-prop ] find-operation ; : secondary-operation ( obj -- operation ) dup - [ operation-command +secondary+ word-prop ] find-operation + [ command>> +secondary+ word-prop ] find-operation [ ] [ primary-operation ] ?if ; : default-flags ( -- assoc ) @@ -59,9 +59,9 @@ SYMBOL: operations : modify-operation ( hook translator operation -- operation ) clone - tuck set-operation-translator - tuck set-operation-hook - t over set-operation-listener? ; + tuck (>>translator) + tuck (>>hook) + t over (>>listener?) ; : modify-operations ( operations hook translator -- operations ) rot [ >r 2dup r> modify-operation ] map 2nip ; @@ -76,9 +76,9 @@ SYMBOL: operations : operation-quot ( target command -- quot ) [ swap literalize , - dup operation-translator % - operation-command , + dup translator>> % + command>> , ] [ ] make ; M: operation invoke-command ( target command -- ) - [ operation-hook call ] keep operation-quot call ; + [ hook>> call ] keep operation-quot call ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 1ae99b800d..2dee1ba4a9 100755 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -64,7 +64,7 @@ M: listener-command invoke-command ( target command -- ) command-quot call-listener ; M: listener-operation invoke-command ( target command -- ) - [ operation-hook call ] keep operation-quot call-listener ; + [ hook>> call ] keep operation-quot call-listener ; : eval-listener ( string -- ) get-workspace