diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index 4967dd2c..2b9e4984 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -28,6 +28,12 @@ [(_ (name contract docs ...) ...) (syntax (provide/contract (name contract) ...))])) + (define-values/invoke-unit/sig + framework^ + framework@ + #f + mred^) + (provide/contract/docs (version:add-spec (any? any? . -> . void?) @@ -90,11 +96,10 @@ "\\scmindex{exn:unknown-preference}\\rawscm{exn:unknown-preference}" "if the preference has not been set.") (preferences:add-callback - (symbol? (symbol? any? . -> . boolean?) . -> . (-> void?)) + (symbol? (symbol? any? . -> . any?) . -> . (-> void?)) (p f) "This function adds a callback which is called with a symbol naming a" - "preference and it's value, when the preference changes. If the" - "callback function returns \\rawscm{\\#f}, the preference is not changed." + "preference and it's value, when the preference changes." "\\rawscm{preferences:add-callback} returns a thunk, which when" "invoked, removes the callback from this preference." "" @@ -583,9 +588,9 @@ "and (send (" "@flink group:get-the-frame-group %" ") " - "@milink open-here get-open-here-frame %" + "@ilink frame:open-here get-open-here-frame %" ") returns a frame, the " - "@milink open-here " + "@ilink frame:open-here open-here " "method of that frame is used to load" "the file in the existing frame." "" @@ -1307,11 +1312,5 @@ (color-model:xyz-z (color-model:xyz? . -> . number?) (xyz) - "Extracts the z component of \\var{xyz}.")) - - (define-values/invoke-unit/sig - framework^ - framework@ - #f - mred^)) + "Extracts the z component of \\var{xyz}."))) diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss index 0423784e..4362747a 100644 --- a/collects/framework/gui-utils.ss +++ b/collects/framework/gui-utils.ss @@ -148,6 +148,7 @@ (gui-utils:get-clicked-clickback-delta (-> (is-a?/c style-delta%)) + () "This delta is designed for use with" "@link text set-clickback %" ". Use it as one of the \\iscmclass{style-delta} argument to" @@ -160,6 +161,7 @@ (gui-utils:get-clickback-delta (-> (is-a?/c style-delta%)) + () "This delta is designed for use with" "@link text set-clickback %" ". Use the result of this function as the style" @@ -167,7 +169,7 @@ "text where the clickback is set." "" "See also" - "@flink gui-utils:get-clickback-clicked-delta %" + "@flink gui-utils:get-clicked-clickback-delta %" ".")) (define clickback-delta (make-object style-delta% 'change-underline #t)) diff --git a/collects/framework/private/preferences.ss b/collects/framework/private/preferences.ss index d1f7635a..9b5a3b9d 100644 --- a/collects/framework/private/preferences.ss +++ b/collects/framework/private/preferences.ss @@ -98,13 +98,12 @@ [else (cons (car callbacks) (loop (cdr callbacks)))]))])))))) - (define check-callbacks - (lambda (p value) - (andmap (lambda (x) - (guard "calling callback" p value - (lambda () ((pref-callback-cb x) p value)) - raise)) - (get-callbacks p)))) + (define (check-callbacks p value) + (for-each (lambda (x) + (guard "calling callback" p value + (lambda () ((pref-callback-cb x) p value)) + raise)) + (get-callbacks p))) (define (get p) (let ([ans (hash-table-get preferences p @@ -127,9 +126,8 @@ (if (checker unmarsh) unmarsh default))] - [pref (if (check-callbacks p unmarshalled) - unmarshalled - default)]) + [pref (begin (check-callbacks p unmarshalled) + unmarshalled)]) (hash-table-put! preferences p (make-pref pref)) pref)] [(pref? ans) @@ -148,12 +146,12 @@ p value)) (cond [(pref? pref) - (when (check-callbacks p value) - (set-pref-value! pref value))] + (check-callbacks p value) + (set-pref-value! pref value)] [(or (marshalled? pref) (not pref)) - (when (check-callbacks p value) - (hash-table-put! preferences p (make-pref value)))] + (check-callbacks p value) + (hash-table-put! preferences p (make-pref value))] [else (error 'prefs.ss "robby error.0: ~a" pref)]))) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index 6dea6575..8c8052b0 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -317,6 +317,7 @@ pasteboard-info% standard-menus% editor% + open-here% text% text-info-file% searchable% diff --git a/collects/framework/test.ss b/collects/framework/test.ss index 4e544bd2..83e11e63 100644 --- a/collects/framework/test.ss +++ b/collects/framework/test.ss @@ -11,6 +11,10 @@ (syntax (provide/contract (name contract) ...))])) (provide/contract/docs + (test:number-pending-actions + (-> number?) + () + "Returns the number of pending events (those that haven't completed yet)") (test:run-interval (case-> (number? . -> . void?)