From 23ae83c7c994decafecdbe0f6782673033b30387 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 16 Dec 2008 14:05:30 -0800 Subject: [PATCH 01/75] Update strftime to pad properly, and add some tests. --- extra/formatting/formatting-tests.factor | 6 ++-- extra/formatting/formatting.factor | 41 ++++++++++++------------ 2 files changed, 23 insertions(+), 24 deletions(-) diff --git a/extra/formatting/formatting-tests.factor b/extra/formatting/formatting-tests.factor index 8616325a81..c7e9fb985e 100644 --- a/extra/formatting/formatting-tests.factor +++ b/extra/formatting/formatting-tests.factor @@ -85,13 +85,13 @@ IN: formatting.tests [ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test [ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test - [ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test [ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test - +[ t ] [ "10/09/08" testtime "%m/%d/%y" strftime = ] unit-test [ t ] [ "Thu" testtime "%a" strftime = ] unit-test [ t ] [ "Thursday" testtime "%A" strftime = ] unit-test - [ t ] [ "Oct" testtime "%b" strftime = ] unit-test [ t ] [ "October" testtime "%B" strftime = ] unit-test +[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test +[ t ] [ "PM" testtime "%p" strftime = ] unit-test diff --git a/extra/formatting/formatting.factor b/extra/formatting/formatting.factor index 7dd8458488..3f12c36bbd 100644 --- a/extra/formatting/formatting.factor +++ b/extra/formatting/formatting.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license USING: accessors arrays ascii calendar combinators fry kernel -io io.encodings.ascii io.files io.streams.string +generalizations io io.encodings.ascii io.files io.streams.string macros math math.functions math.parser peg.ebnf quotations sequences splitting strings unicode.case vectors ; @@ -32,10 +32,7 @@ IN: formatting [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ; : max-digits ( n digits -- n' ) - 10 swap ^ [ * round ] keep / ; - -: max-width ( string length -- string' ) - short head ; + 10 swap ^ [ * round ] keep / ; inline : >exp ( x -- exp base ) [ @@ -69,7 +66,7 @@ pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = sign = ("+")? => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]] -width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]] +width_ = "." ([0-9])* => [[ second >digits '[ _ short head ] ]] width = (width_)? => [[ [ ] or ]] digits_ = "." ([0-9])* => [[ second >digits ]] @@ -113,23 +110,25 @@ MACRO: printf ( format-string -- ) string 2 CHAR: 0 pad-left ; inline + +: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline : >time ( timestamp -- string ) [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array - [ number>string zero-pad ] map ":" join ; inline + [ pad-00 ] map ":" join ; inline : >date ( timestamp -- string ) [ month>> ] [ day>> ] [ year>> ] tri 3array - [ number>string zero-pad ] map "/" join ; inline + [ pad-00 ] map "/" join ; inline : >datetime ( timestamp -- string ) { [ day-of-week day-abbreviation3 ] [ month>> month-abbreviation ] - [ day>> number>string zero-pad ] + [ day>> pad-00 ] [ >time ] [ year>> number>string ] - } cleave 3array [ 2array ] dip append " " join ; inline + } cleave 5 narray " " join ; inline : (week-of-year) ( timestamp day -- n ) [ dup clone 1 >>month 1 >>day day-of-week dup ] dip > [ 7 swap - ] when @@ -147,20 +146,20 @@ fmt-A = "A" => [[ [ dup day-of-week day-name ] ]] fmt-b = "b" => [[ [ dup month>> month-abbreviation ] ]] fmt-B = "B" => [[ [ dup month>> month-name ] ]] fmt-c = "c" => [[ [ dup >datetime ] ]] -fmt-d = "d" => [[ [ dup day>> number>string zero-pad ] ]] -fmt-H = "H" => [[ [ dup hour>> number>string zero-pad ] ]] -fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when number>string zero-pad ] ]] -fmt-j = "j" => [[ [ dup day-of-year number>string ] ]] -fmt-m = "m" => [[ [ dup month>> number>string zero-pad ] ]] -fmt-M = "M" => [[ [ dup minute>> number>string zero-pad ] ]] +fmt-d = "d" => [[ [ dup day>> pad-00 ] ]] +fmt-H = "H" => [[ [ dup hour>> pad-00 ] ]] +fmt-I = "I" => [[ [ dup hour>> dup 12 > [ 12 - ] when pad-00 ] ]] +fmt-j = "j" => [[ [ dup day-of-year pad-000 ] ]] +fmt-m = "m" => [[ [ dup month>> pad-00 ] ]] +fmt-M = "M" => [[ [ dup minute>> pad-00 ] ]] fmt-p = "p" => [[ [ dup hour>> 12 < "AM" "PM" ? ] ]] -fmt-S = "S" => [[ [ dup second>> round number>string zero-pad ] ]] -fmt-U = "U" => [[ [ dup week-of-year-sunday ] ]] +fmt-S = "S" => [[ [ dup second>> floor pad-00 ] ]] +fmt-U = "U" => [[ [ dup week-of-year-sunday pad-00 ] ]] fmt-w = "w" => [[ [ dup day-of-week number>string ] ]] -fmt-W = "W" => [[ [ dup week-of-year-monday ] ]] +fmt-W = "W" => [[ [ dup week-of-year-monday pad-00 ] ]] fmt-x = "x" => [[ [ dup >date ] ]] fmt-X = "X" => [[ [ dup >time ] ]] -fmt-y = "y" => [[ [ dup year>> 100 mod number>string ] ]] +fmt-y = "y" => [[ [ dup year>> 100 mod pad-00 ] ]] fmt-Y = "Y" => [[ [ dup year>> number>string ] ]] fmt-Z = "Z" => [[ [ "Not yet implemented" throw ] ]] unknown = (.)* => [[ "Unknown directive" throw ]] From 9a21db3b89cef73b9762157e6959607106942d85 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 16 Dec 2008 14:05:55 -0800 Subject: [PATCH 02/75] Fix typo in google-tech-talk. --- extra/google-tech-talk/google-tech-talk.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor index 3477fbe4bd..84c0134b82 100644 --- a/extra/google-tech-talk/google-tech-talk.factor +++ b/extra/google-tech-talk/google-tech-talk.factor @@ -203,7 +203,7 @@ IN: google-tech-talk { $code "13 tell-me" } { $code "103 76 tell-me" } { $code "101 tell-me" } - { { $link integer } ", " { $link array } ", and others area built-in classes" } + { { $link integer } ", " { $link array } ", and others are built-in classes" } } { $slide "Object system" "Anyone can define new shapes..." From 35039d01498824be1ad39bcd7cf704920bbd779e Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Fri, 19 Dec 2008 00:20:56 +0100 Subject: [PATCH 03/75] FUEL: Fix bug whereby true display-stacks? could hang the listener. --- extra/fuel/fuel.factor | 12 +++++------- misc/fuel/fu.el | 3 +++ misc/fuel/fuel-connection.el | 14 ++++++++++---- misc/fuel/fuel-listener.el | 3 +++ misc/fuel/fuel-mode.el | 15 +++++++-------- 5 files changed, 28 insertions(+), 19 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 017b20b54b..8e7122fee3 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -13,7 +13,7 @@ IN: fuel ! Evaluation status: -TUPLE: fuel-status in use ds? restarts ; +TUPLE: fuel-status in use restarts ; SYMBOL: fuel-status-stack V{ } clone fuel-status-stack set-global @@ -37,7 +37,7 @@ t clone fuel-eval-res-flag set-global f fuel-eval-res-flag set-global ; inline : push-fuel-status ( -- ) - in get use get clone display-stacks? get restarts get-global clone + in get use get clone restarts get-global clone fuel-status boa fuel-status-stack get push ; @@ -46,7 +46,6 @@ t clone fuel-eval-res-flag set-global fuel-status-stack get pop { [ in>> in set ] [ use>> clone use set ] - [ ds?>> display-stacks? swap [ on ] [ off ] if ] [ restarts>> fuel-eval-restartable? [ drop ] [ clone restarts set-global @@ -112,7 +111,7 @@ M: source-file fuel-pprint path>> fuel-pprint ; error get fuel-eval-result get-global fuel-eval-output get-global - 3array fuel-pprint flush nl "EOT:" write ; + 3array fuel-pprint flush nl "<~FUEL~>" write nl flush ; : fuel-forget-error ( -- ) f error set-global ; inline : fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline @@ -120,14 +119,13 @@ M: source-file fuel-pprint path>> fuel-pprint ; : (fuel-begin-eval) ( -- ) push-fuel-status - display-stacks? off fuel-forget-error fuel-forget-result fuel-forget-output ; : (fuel-end-eval) ( quot -- ) - with-string-writer fuel-eval-output set-global - fuel-retort pop-fuel-status ; inline + with-string-writer fuel-eval-output set-global fuel-retort + pop-fuel-status ; inline : (fuel-eval) ( lines -- ) [ [ parse-lines ] with-compilation-unit call ] curry diff --git a/misc/fuel/fu.el b/misc/fuel/fu.el index 508d7ef3a4..ffd88bf144 100644 --- a/misc/fuel/fu.el +++ b/misc/fuel/fu.el @@ -17,6 +17,9 @@ (autoload 'run-factor "fuel-listener.el" "Start a Factor listener, or switch to a running one." t) +(autoload 'switch-to-factor "fuel-listener.el" + "Start a Factor listener, or switch to a running one." t) + (autoload 'fuel-autodoc-mode "fuel-help.el" "Minor mode showing in the minibuffer a synopsis of Factor word at point." t) diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index 3cac40bd16..162a1edd02 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -133,21 +133,27 @@ (fuel-con--connection-start-timer conn)))) (defconst fuel-con--prompt-regex "( .+ ) ") -(defconst fuel-con--eot-marker "EOT:") -(defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker)) +(defconst fuel-con--eot-marker "<~FUEL~>") +(defconst fuel-con--init-stanza "USE: fuel f fuel-eval") (defconst fuel-con--comint-finished-regex - (format "^%s%s$" fuel-con--eot-marker fuel-con--prompt-regex)) + (format "^%s$" fuel-con--eot-marker)) (defun fuel-con--setup-comint () - (comint-redirect-cleanup) (set (make-local-variable 'comint-redirect-insert-matching-regexp) t) + (add-hook 'comint-redirect-filter-functions + 'fuel-con--comint-preoutput-filter nil t) (add-hook 'comint-redirect-hook 'fuel-con--comint-redirect-hook nil t)) (defadvice comint-redirect-setup (after fuel-con--advice activate) (setq comint-redirect-finished-regexp fuel-con--comint-finished-regex)) +(defun fuel-con--comint-preoutput-filter (str) + (when (string-match fuel-con--comint-finished-regex str) + (setq comint-redirect-finished-regexp fuel-con--prompt-regex)) + str) + ;;; Requests handling: diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index c1e8d670cf..a12fc817a3 100644 --- a/misc/fuel/fuel-listener.el +++ b/misc/fuel/fuel-listener.el @@ -76,6 +76,7 @@ buffer." (make-comint-in-buffer "fuel listener" (current-buffer) factor nil "-run=listener" (format "-i=%s" image)) (fuel-listener--wait-for-prompt 10000) + (fuel-con--setup-connection (current-buffer)) (fuel-con--send-string/wait (current-buffer) fuel-con--init-stanza '(lambda (s) (message "FUEL listener up and running!")) @@ -130,10 +131,12 @@ buffer." ;;; Fuel listener mode: +;;;###autoload (define-derived-mode fuel-listener-mode comint-mode "Fuel Listener" "Major mode for interacting with an inferior Factor listener process. \\{fuel-listener-mode-map}" (set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex) + (set (make-local-variable 'comint-use-prompt-regexp) t) (set (make-local-variable 'comint-prompt-read-only) t) (fuel-listener--setup-completion)) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 265cfde0a2..714b9f0104 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -14,15 +14,14 @@ ;;; Code: -(require 'factor-mode) -(require 'fuel-base) -(require 'fuel-syntax) -(require 'fuel-font-lock) -(require 'fuel-debug) -(require 'fuel-help) -(require 'fuel-eval) -(require 'fuel-completion) (require 'fuel-listener) +(require 'fuel-completion) +(require 'fuel-eval) +(require 'fuel-help) +(require 'fuel-debug) +(require 'fuel-font-lock) +(require 'fuel-syntax) +(require 'fuel-base) ;;; Customization: From 98203729ed89e88de075b99f73b9c744837363cb Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Fri, 19 Dec 2008 00:37:04 +0100 Subject: [PATCH 04/75] FUEL: USINGs fixed. --- extra/fuel/fuel.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index b62fc2bed2..1c8bfd1522 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -6,8 +6,8 @@ combinators compiler.units continuations debugger definitions eval help io io.files io.pathnames io.streams.string kernel lexer listener listener.private make math memoize namespaces parser prettyprint prettyprint.config quotations sequences sets -sorting source-files strings tools.vocabs vectors vocabs -vocabs.loader vocabs.parser summary ; +sorting source-files strings summary tools.vocabs vectors +vocabs vocabs.loader vocabs.parser ; IN: fuel From 7836b2c6f461b40db041db3e85fce53bc2e717e0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Dec 2008 21:02:46 -0600 Subject: [PATCH 05/75] / >fixnum should be /i --- basis/ui/gadgets/editors/editors.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 72d5900c28..67386c1807 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -107,7 +107,7 @@ M: editor ungraft* editor-font* "" string-height ; : y>line ( y editor -- line# ) - line-height / >fixnum ; + line-height /i ; :: point>loc ( point editor -- loc ) point second editor y>line { From 74df92d12dee0a905b132cef6e4bcc421c8fb550 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Dec 2008 21:17:24 -0600 Subject: [PATCH 06/75] Fix --- basis/struct-arrays/struct-arrays-tests.factor | 12 +++++++++++- basis/struct-arrays/struct-arrays.factor | 4 ++-- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/basis/struct-arrays/struct-arrays-tests.factor b/basis/struct-arrays/struct-arrays-tests.factor index d2bf583b5a..6f77e66cd2 100755 --- a/basis/struct-arrays/struct-arrays-tests.factor +++ b/basis/struct-arrays/struct-arrays-tests.factor @@ -1,6 +1,7 @@ IN: struct-arrays.tests USING: struct-arrays tools.test kernel math sequences -alien.syntax alien.c-types destructors libc accessors ; +alien.syntax alien.c-types destructors libc accessors +destructors ; C-STRUCT: test-struct { "int" "x" } @@ -27,3 +28,12 @@ C-STRUCT: test-struct 0 [ [ test-struct-x ] [ test-struct-y ] bi / + ] reduce ] with-destructors ] unit-test + +[ ] [ ALIEN: 123 10 "test-struct" drop ] unit-test + +[ ] [ + [ + 10 "test-struct" malloc-struct-array + underlying>> &free drop + ] with-destructors +] unit-test \ No newline at end of file diff --git a/basis/struct-arrays/struct-arrays.factor b/basis/struct-arrays/struct-arrays.factor index 33a469d0c8..ba0524009f 100755 --- a/basis/struct-arrays/struct-arrays.factor +++ b/basis/struct-arrays/struct-arrays.factor @@ -32,9 +32,9 @@ ERROR: bad-byte-array-length byte-array ; ] keep struct-array boa ; inline : ( alien length c-type -- struct-array ) - struct-array boa ; inline + heap-size struct-array boa ; inline : malloc-struct-array ( length c-type -- struct-array ) - heap-size [ calloc ] 2keep ; + [ heap-size calloc ] 2keep ; INSTANCE: struct-array sequence From 41d3b13f7c971039a6c63ea7bf4e3a254e24a7b2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Dec 2008 21:17:33 -0600 Subject: [PATCH 07/75] f print-topic no longer prints an error --- basis/help/help-tests.factor | 1 + basis/help/help.factor | 1 + 2 files changed, 2 insertions(+) diff --git a/basis/help/help-tests.factor b/basis/help/help-tests.factor index e38f2fc15d..e091278359 100644 --- a/basis/help/help-tests.factor +++ b/basis/help/help-tests.factor @@ -3,3 +3,4 @@ USING: tools.test help kernel ; [ 3 throw ] must-fail [ ] [ :help ] unit-test +[ ] [ f print-topic ] unit-test \ No newline at end of file diff --git a/basis/help/help.factor b/basis/help/help.factor index cd80a73dad..272bdc1db3 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -112,6 +112,7 @@ M: word set-article-parent swap "help-parent" set-word-prop ; ] with-style nl ; : print-topic ( topic -- ) + >link last-element off dup $title article-content print-content nl ; From 28b3b4b97abf11ee8cd13643b1780d84f5c84759 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Dec 2008 23:44:14 -0600 Subject: [PATCH 08/75] add a lot more to the using list --- basis/io/files/links/links-tests.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/io/files/links/links-tests.factor b/basis/io/files/links/links-tests.factor index 2d142ce900..bc03e42f92 100644 --- a/basis/io/files/links/links-tests.factor +++ b/basis/io/files/links/links-tests.factor @@ -1,5 +1,6 @@ -USING: io.directories io.files.links tools.test -io.files.unique tools.files fry ; +USING: io.directories io.files.links tools.test sequences +io.files.unique tools.files fry math kernel math.parser +io.pathnames namespaces ; IN: io.files.links.tests : make-test-links ( n path -- ) From 766fccaeccadeb3429f9ab0aaef2f9ab4d7df228 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Dec 2008 23:56:16 -0600 Subject: [PATCH 09/75] Compose model fires less unnecessary notifications --- basis/models/compose/compose-tests.factor | 24 ++++++++++++++++++++++- basis/models/compose/compose.factor | 3 ++- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/basis/models/compose/compose-tests.factor b/basis/models/compose/compose-tests.factor index 16a5ab339c..0644bb6841 100644 --- a/basis/models/compose/compose-tests.factor +++ b/basis/models/compose/compose-tests.factor @@ -1,5 +1,5 @@ USING: arrays generic kernel math models namespaces sequences assocs -tools.test models.compose accessors ; +tools.test models.compose accessors locals ; IN: models.compose.tests ! Test compose @@ -22,3 +22,25 @@ IN: models.compose.tests [ { 4 5 } ] [ "c" get value>> ] unit-test [ ] [ "c" get deactivate-model ] unit-test + +TUPLE: an-observer { i integer } ; + +M: an-observer model-changed nip [ 1+ ] change-i drop ; + +[ 1 0 ] [ + [let* | m1 [ 1 ] + m2 [ 2 ] + c [ { m1 m2 } ] + o1 [ an-observer new ] + o2 [ an-observer new ] | + + o1 m1 add-connection + o2 m2 add-connection + + c activate-model + + "OH HAI" m1 set-model + o1 i>> + o2 i>> + ] +] unit-test \ No newline at end of file diff --git a/basis/models/compose/compose.factor b/basis/models/compose/compose.factor index a2c3385248..386a06781d 100644 --- a/basis/models/compose/compose.factor +++ b/basis/models/compose/compose.factor @@ -18,7 +18,8 @@ TUPLE: compose < model ; M: compose model-changed nip - [ [ value>> ] composed-value ] keep set-model ; + dup [ value>> ] composed-value >>value + notify-connections ; M: compose model-activated dup model-changed ; From 69c64ba803f8360182ccc42fec1132d843592351 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Dec 2008 23:56:41 -0600 Subject: [PATCH 10/75] Refactor operations-menu code to make it independent of presentations --- basis/ui/gadgets/menus/menus.factor | 8 ++++++- .../presentations/presentations.factor | 21 +++++++------------ 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor index 2aef0b8417..c482f31896 100644 --- a/basis/ui/gadgets/menus/menus.factor +++ b/basis/ui/gadgets/menus/menus.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: locals accessors arrays ui.commands ui.gadgets +USING: locals accessors arrays ui.commands ui.operations ui.gadgets ui.gadgets.buttons ui.gadgets.worlds ui.gestures generic hashtables kernel math models namespaces opengl sequences math.vectors ui.gadgets.theme ui.gadgets.packs @@ -54,3 +54,9 @@ M: menu-glass layout* gadget-child prefer ; : show-commands-menu ( target commands -- ) [ dup [ ] ] dip show-menu ; + +: ( target hook -- menu ) + over object-operations ; + +: show-operations-menu ( gadget target -- ) + [ ] show-menu ; \ No newline at end of file diff --git a/basis/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor index 61a55e926b..f05ea5ae5d 100644 --- a/basis/ui/gadgets/presentations/presentations.factor +++ b/basis/ui/gadgets/presentations/presentations.factor @@ -11,8 +11,8 @@ IN: ui.gadgets.presentations TUPLE: presentation < button object hook ; : invoke-presentation ( presentation command -- ) - over dup hook>> call - [ object>> ] dip invoke-command ; + [ [ dup hook>> call ] [ object>> ] bi ] dip + invoke-command ; : invoke-primary ( presentation -- ) dup object>> primary-operation @@ -23,7 +23,7 @@ TUPLE: presentation < button object hook ; invoke-presentation ; : show-mouse-help ( presentation -- ) - dup object>> over show-summary button-update ; + [ [ object>> ] keep show-summary ] [ button-update ] bi ; : ( label object -- button ) swap [ invoke-primary ] presentation new-button @@ -35,18 +35,13 @@ M: presentation ungraft* dup hand-gadget get-global child? [ dup hide-status ] when call-next-method ; -: ( presentation -- menu ) - [ object>> ] - [ dup hook>> curry ] - [ object>> object-operations ] - tri ; - -: operations-menu ( presentation -- ) - dup show-menu ; +: show-operations-menu ( presentation -- ) + [ ] [ object>> ] [ dup hook>> curry ] tri + show-menu ; presentation H{ - { T{ button-down f f 3 } [ operations-menu ] } - { T{ mouse-leave } [ dup hide-status button-update ] } + { T{ button-down f f 3 } [ show-operations-menu ] } + { T{ mouse-leave } [ [ hide-status ] [ button-update ] bi ] } { T{ mouse-enter } [ show-mouse-help ] } ! Responding to motion too allows nested presentations to ! display status help properly, when the mouse leaves a From 84cafde43a30130ec4ea03b52dc282f553697922 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 19 Dec 2008 00:13:12 -0600 Subject: [PATCH 11/75] Fix load error --- basis/ui/gadgets/presentations/presentations-docs.factor | 2 -- 1 file changed, 2 deletions(-) diff --git a/basis/ui/gadgets/presentations/presentations-docs.factor b/basis/ui/gadgets/presentations/presentations-docs.factor index c651e849a2..005fa1e7fe 100644 --- a/basis/ui/gadgets/presentations/presentations-docs.factor +++ b/basis/ui/gadgets/presentations/presentations-docs.factor @@ -35,8 +35,6 @@ HELP: {