diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index 99e3f8e3..3010f372 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -1240,8 +1240,22 @@ "That is, \\var{keymap} must be chained to some keymap attached" "to the editor.") - - (scheme:add-preferences-panel + (scheme:text-balanced? + (opt-> + ((is-a?/c text%)) + (number? (union false? number?)) + boolean?) + ((text) + ((start 0) (end #f))) + "Determines if the range in the editor from \\var{start} to \\var{end} in \\var{text}" + "is a matched set of parenthesis. If \\var{end} is \\scheme{#f}, it" + "defaults to the last position of the \\var{text}." + "" + "The implementation of this function creates a port with" + "@flink open-input-text-editor" + "and then uses `read' to parse the range of the buffer.") + + (scheme:add-preferences-panel (-> void?) () "Adds a tabbing preferences panel to the preferences dialog.") diff --git a/collects/framework/private/comment-box.ss b/collects/framework/private/comment-box.ss index c553b7c1..4482af2a 100644 --- a/collects/framework/private/comment-box.ss +++ b/collects/framework/private/comment-box.ss @@ -38,11 +38,24 @@ (cons (keymap:get-file) (super-get-keymaps))) (super-instantiate ()))) + (define scheme+copy-self% #f) + (define (get-scheme+copy-self%) + (unless scheme+copy-self% + (set! scheme+copy-self% + (class scheme:text% + (inherit copy-self-to) + (define/override (copy-self) + (let ([ed (new scheme+copy-self%)]) + (copy-self-to ed) + ed)) + (super-new)))) + scheme+copy-self%) + (define -snip% (class* decorated-editor-snip% (readable-snip<%>) (inherit get-editor get-style) - (define/override (make-editor) (new scheme:text%)) + (define/override (make-editor) (new (get-scheme+copy-self%))) (define/override (make-snip) (make-object -snip%)) (define/override (get-corner-bitmap) bm) (define/override (get-position) 'left-top) diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index 0e47d9f2..d4ff34fe 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -43,6 +43,16 @@ [-text% text%]) + (define text-balanced? + (opt-lambda (text [start 0] [in-end #f]) + (let* ([end (or in-end (send text last-position))] + [port (open-input-text-editor text start end)]) + (with-handlers ([exn:read:eof? (lambda (x) #f)]) + (let loop () + (let ([s (read port)]) + (or (eof-object? s) + (loop)))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; Sexp Snip ;; diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index 558f7c43..a84b404d 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -522,7 +522,9 @@ get-color-prefs-table short-sym->pref-name - short-sym->style-name)) + short-sym->style-name + + text-balanced?)) (define-signature framework:scheme^ ((open framework:scheme-class^) (open framework:scheme-fun^))) diff --git a/collects/framework/private/standard-menus-items.ss b/collects/framework/private/standard-menus-items.ss index 7377e972..1e302310 100644 --- a/collects/framework/private/standard-menus-items.ss +++ b/collects/framework/private/standard-menus-items.ss @@ -358,7 +358,7 @@ (make-an-item 'edit-menu 'replace-and-find-again '(string-constant replace-and-find-again-info) '(lambda (item control) (void)) - #\h + '(if (eq? (system-type) 'macosx) #f #\h) '(string-constant replace-and-find-again-menu-item) edit-menu:edit-target-on-demand #f) diff --git a/collects/tests/framework/framework-test-engine.icns b/collects/tests/framework/framework-test-engine.icns new file mode 100644 index 00000000..4dbb8be9 Binary files /dev/null and b/collects/tests/framework/framework-test-engine.icns differ