suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed PR 9140

Browse Source 
svn: r8374
This commit is contained in:
Robby Findler 2008-01-21 00:33:28 +00:00
parent 6018c35cc8
commit d219107a0a
4 changed files with 521 additions and 508 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/drscheme/private/debug.ss
View File

@ -275,7 +275,7 @@ profile todo:
(let ([note (new note%)]) (let ([note (new note%)])
(send note set-callback (λ () (show-backtrace-window msg cms))) (send note set-callback (λ () (show-backtrace-window msg cms)))
(write-special note (current-error-port)) (write-special note (current-error-port))
(display #\space (current-error-port))))))) (display #\space (current-error-port)) )))))
(define (show-error-and-highlight msg exn highlight-errors) (define (show-error-and-highlight msg exn highlight-errors)
(let ([cms (let ([cms
@ -285,10 +285,8 @@ profile todo:
(when (and cms (when (and cms
(pair? cms)) (pair? cms))
(print-bug-to-stderr msg cms)) (print-bug-to-stderr msg cms))
(let ([srcs-to-display (find-src-to-display exn cms)]) (let ([srcs-to-display (find-src-to-display exn cms)])
(for-each display-srcloc-in-error srcs-to-display) (for-each display-srcloc-in-error srcs-to-display)
(display msg (current-error-port)) (display msg (current-error-port))
(when (exn:fail:syntax? exn) (when (exn:fail:syntax? exn)
(show-syntax-error-context (current-error-port) exn)) (show-syntax-error-context (current-error-port) exn))

12
collects/drscheme/private/language.ss
View File

@ -351,7 +351,17 @@
(exact? x) (exact? x)
(real? x) (real? x)
(not (integer? x))))]) (not (integer? x))))])
(parameterize ([pretty-print-columns width] (parameterize (
;; these three handlers aren't used, but are set to override the user's settings
[pretty-print-print-line (λ (line-number op old-line dest-columns)
(when (and (not (equal? line-number 0))
(not (equal? dest-columns 'infinity)))
(newline op))
0)]
[pretty-print-pre-print-hook (λ (val port) (void))]
[pretty-print-post-print-hook (λ (val port) (void))]
[pretty-print-columns width]
[pretty-print-size-hook [pretty-print-size-hook
(λ (value display? port) (λ (value display? port)
(cond (cond

222
collects/drscheme/private/main.ss
View File

@ -1,21 +1,17 @@
#lang scheme/unit #lang scheme/unit
(require (lib "string-constant.ss" "string-constants")
(lib "cmdline.ss") (require (lib "string-constant.ss" "string-constants")
(lib "contract.ss") (lib "contract.ss")
"drsig.ss" "drsig.ss"
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
(lib "framework.ss" "framework") (lib "framework.ss" "framework")
(lib "class.ss") (lib "class.ss")
(prefix-in pretty-print: (lib "pretty.ss"))
(prefix-in print-convert: (lib "pconvert.ss"))
(lib "include.ss")
(lib "list.ss") (lib "list.ss")
scheme/path scheme/path
(lib "external.ss" "browser") (lib "external.ss" "browser")
(lib "plt-installer.ss" "setup")) (lib "plt-installer.ss" "setup"))
(import [prefix drscheme:app: drscheme:app^] (import [prefix drscheme:app: drscheme:app^]
[prefix drscheme:unit: drscheme:unit^] [prefix drscheme:unit: drscheme:unit^]
[prefix drscheme:get/extend: drscheme:get/extend^] [prefix drscheme:get/extend: drscheme:get/extend^]
[prefix drscheme:language-configuration: drscheme:language-configuration/internal^] [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]
@ -27,16 +23,16 @@
[prefix drscheme:font: drscheme:font^] [prefix drscheme:font: drscheme:font^]
[prefix drscheme:modes: drscheme:modes^] [prefix drscheme:modes: drscheme:modes^]
[prefix drscheme:help-desk: drscheme:help-desk^]) [prefix drscheme:help-desk: drscheme:help-desk^])
(export) (export)
(application-file-handler (application-file-handler
(let ([default (application-file-handler)]) (let ([default (application-file-handler)])
(λ (name) (λ (name)
(if (null? (get-top-level-windows)) (if (null? (get-top-level-windows))
(handler:edit-file name) (handler:edit-file name)
(default name))))) (default name)))))
(application-quit-handler (application-quit-handler
(let ([default (application-quit-handler)]) (let ([default (application-quit-handler)])
(λ () (λ ()
(if (null? (get-top-level-windows)) (if (null? (get-top-level-windows))
@ -44,20 +40,20 @@
(exit:exit)) (exit:exit))
(default))))) (default)))))
(application-about-handler (application-about-handler
(λ () (λ ()
(drscheme:app:about-drscheme))) (drscheme:app:about-drscheme)))
(drscheme:modes:add-initial-modes) (drscheme:modes:add-initial-modes)
(namespace-set-variable-value! 'help-desk:frame-mixin drscheme:frame:basics-mixin) (namespace-set-variable-value! 'help-desk:frame-mixin drscheme:frame:basics-mixin)
(finder:default-filters (list* '("Scheme (.scm)" "*.scm") (finder:default-filters (list* '("Scheme (.scm)" "*.scm")
'("Scheme (.ss)" "*.ss") '("Scheme (.ss)" "*.ss")
(finder:default-filters))) (finder:default-filters)))
(application:current-app-name (string-constant drscheme)) (application:current-app-name (string-constant drscheme))
(preferences:set-default 'drscheme:htdp:last-set-teachpacks (preferences:set-default 'drscheme:htdp:last-set-teachpacks
'() '()
(λ (x) (λ (x)
(and (list? x) (and (list? x)
@ -67,20 +63,20 @@
(eq? (car x) 'lib) (eq? (car x) 'lib)
(andmap string? (cdr x)))) (andmap string? (cdr x))))
x)))) x))))
(preferences:set-default 'drscheme:defs/ints-horizontal #f boolean?) (preferences:set-default 'drscheme:defs/ints-horizontal #f boolean?)
(preferences:set-default 'drscheme:unit-window-max? #f boolean?) (preferences:set-default 'drscheme:unit-window-max? #f boolean?)
(preferences:set-default 'drscheme:frame:initial-position #f (preferences:set-default 'drscheme:frame:initial-position #f
(λ (x) (or (not x) (λ (x) (or (not x)
(and (pair? x) (and (pair? x)
(number? (car x)) (number? (car x))
(number? (cdr x)))))) (number? (cdr x))))))
(preferences:set-default 'drscheme:limit-memory #f (preferences:set-default 'drscheme:limit-memory #f
(λ (x) (or (boolean? x) (λ (x) (or (boolean? x)
(integer? x) (integer? x)
(x . >= . (* 1024 1024 100))))) (x . >= . (* 1024 1024 100)))))
(preferences:set-default 'drscheme:recent-language-names (preferences:set-default 'drscheme:recent-language-names
null null
(λ (x) (λ (x)
(and (list? x) (and (list? x)
@ -89,16 +85,16 @@
(and (pair? x) (and (pair? x)
(string? (car x)))) (string? (car x))))
x)))) x))))
(preferences:set-default 'drscheme:show-interactions-on-execute #t boolean?) (preferences:set-default 'drscheme:show-interactions-on-execute #t boolean?)
(preferences:set-default 'drscheme:open-in-tabs #f boolean?) (preferences:set-default 'drscheme:open-in-tabs #f boolean?)
(preferences:set-default 'drscheme:toolbar-shown #t boolean?) (preferences:set-default 'drscheme:toolbar-shown #t boolean?)
(preferences:set-default 'drscheme:user-defined-keybindings (preferences:set-default 'drscheme:user-defined-keybindings
'() '()
(λ (x) (and (list? x) (λ (x) (and (list? x)
(andmap (λ (x) (or (path? x) (drscheme:frame:planet-spec? x))) (andmap (λ (x) (or (path? x) (drscheme:frame:planet-spec? x)))
x)))) x))))
(preferences:set-un/marshall (preferences:set-un/marshall
'drscheme:user-defined-keybindings 'drscheme:user-defined-keybindings
(λ (in) (map (λ (x) (if (path? x) (path->bytes x) x)) (λ (in) (map (λ (x) (if (path? x) (path->bytes x) x))
in)) in))
@ -106,7 +102,7 @@
(map (λ (x) (if (bytes? x) (bytes->path x) x)) ex) (map (λ (x) (if (bytes? x) (bytes->path x) x)) ex)
'()))) '())))
(let ([number-between-zero-and-one? (let ([number-between-zero-and-one?
(λ (x) (and (number? x) (<= 0 x 1)))]) (λ (x) (and (number? x) (<= 0 x 1)))])
(preferences:set-default 'drscheme:unit-window-size-percentage (preferences:set-default 'drscheme:unit-window-size-percentage
1/2 1/2
@ -114,10 +110,10 @@
(preferences:set-default 'drscheme:module-browser-size-percentage (preferences:set-default 'drscheme:module-browser-size-percentage
1/5 1/5
number-between-zero-and-one?)) number-between-zero-and-one?))
(preferences:set-default 'drscheme:module-browser:name-length 1 (preferences:set-default 'drscheme:module-browser:name-length 1
(λ (x) (memq x '(0 1 2)))) (λ (x) (memq x '(0 1 2))))
(let ([frame-width 600] (let ([frame-width 600]
[frame-height 650] [frame-height 650]
[window-trimming-upper-bound-width 20] [window-trimming-upper-bound-width 20]
[window-trimming-upper-bound-height 50]) [window-trimming-upper-bound-height 50])
@ -127,28 +123,28 @@
(preferences:set-default 'drscheme:unit-window-width frame-width number?) (preferences:set-default 'drscheme:unit-window-width frame-width number?)
(preferences:set-default 'drscheme:unit-window-height frame-height number?)) (preferences:set-default 'drscheme:unit-window-height frame-height number?))
(preferences:set-default 'drscheme:backtrace-window-width 400 number?) (preferences:set-default 'drscheme:backtrace-window-width 400 number?)
(preferences:set-default 'drscheme:backtrace-window-height 300 number?) (preferences:set-default 'drscheme:backtrace-window-height 300 number?)
(preferences:set-default 'drscheme:backtrace-window-x 0 number?) (preferences:set-default 'drscheme:backtrace-window-x 0 number?)
(preferences:set-default 'drscheme:backtrace-window-y 0 number?) (preferences:set-default 'drscheme:backtrace-window-y 0 number?)
(preferences:set-default 'drscheme:profile-how-to-count 'time (preferences:set-default 'drscheme:profile-how-to-count 'time
(λ (x) (λ (x)
(memq x '(time count)))) (memq x '(time count))))
(preferences:set-default 'drscheme:profile:low-color (preferences:set-default 'drscheme:profile:low-color
(make-object color% 150 255 150) (make-object color% 150 255 150)
(λ (x) (is-a? x color%))) (λ (x) (is-a? x color%)))
(preferences:set-default 'drscheme:profile:high-color (preferences:set-default 'drscheme:profile:high-color
(make-object color% 255 150 150) (make-object color% 255 150 150)
(λ (x) (is-a? x color%))) (λ (x) (is-a? x color%)))
(preferences:set-default 'drscheme:profile:scale (preferences:set-default 'drscheme:profile:scale
'linear 'linear
(λ (x) (memq x '(sqrt linear square)))) (λ (x) (memq x '(sqrt linear square))))
(preferences:set-default 'drscheme:test-coverage-ask-about-clearing? #t boolean?) (preferences:set-default 'drscheme:test-coverage-ask-about-clearing? #t boolean?)
;; size is in editor positions ;; size is in editor positions
(preferences:set-default 'drscheme:repl-buffer-size (preferences:set-default 'drscheme:repl-buffer-size
'(#t . 1000) '(#t . 1000)
(λ (x) (λ (x)
(and (pair? x) (and (pair? x)
@ -156,7 +152,7 @@
(integer? (cdr x)) (integer? (cdr x))
(<= 1 (cdr x) 10000)))) (<= 1 (cdr x) 10000))))
(let ([marshall-color (let ([marshall-color
(λ (c) (λ (c)
(list (send c red) (send c green) (send c blue)))] (list (send c red) (send c green) (send c blue)))]
[unmarshall-color [unmarshall-color
@ -176,42 +172,42 @@
marshall-color marshall-color
unmarshall-color)) unmarshall-color))
(preferences:set-default (preferences:set-default
'drscheme:keybindings-window-size 'drscheme:keybindings-window-size
(cons 200 400) (cons 200 400)
(λ (x) (and (pair? x) (λ (x) (and (pair? x)
(number? (car x)) (number? (car x))
(number? (cdr x))))) (number? (cdr x)))))
(preferences:set-default (preferences:set-default
'drscheme:execute-warning-once 'drscheme:execute-warning-once
#f #f
(λ (x) (λ (x)
(or (eq? x #t) (or (eq? x #t)
(not x)))) (not x))))
(preferences:set-default 'drscheme:switch-to-module-language-automatically? #t boolean?) (preferences:set-default 'drscheme:switch-to-module-language-automatically? #t boolean?)
(preferences:set-default (preferences:set-default
'drscheme:default-tools-configuration 'drscheme:default-tools-configuration
'load 'load
(lambda (p) (lambda (p)
(memq p '(load skip)))) (memq p '(load skip))))
(preferences:set-default (preferences:set-default
'drscheme:tools-configuration 'drscheme:tools-configuration
null null
list?) list?)
(drscheme:font:setup-preferences) (drscheme:font:setup-preferences)
(color-prefs:add-background-preferences-panel) (color-prefs:add-background-preferences-panel)
(scheme:add-preferences-panel) (scheme:add-preferences-panel)
(scheme:add-coloring-preferences-panel) (scheme:add-coloring-preferences-panel)
(preferences:add-editor-checkbox-panel) (preferences:add-editor-checkbox-panel)
(preferences:add-warnings-checkbox-panel) (preferences:add-warnings-checkbox-panel)
(preferences:add-scheme-checkbox-panel) (preferences:add-scheme-checkbox-panel)
(let ([make-check-box (let ([make-check-box
(λ (pref-sym string parent) (λ (pref-sym string parent)
(let ([q (make-object check-box% (let ([q (make-object check-box%
string string
@ -282,42 +278,42 @@
(make-check-box 'drscheme:test-coverage-ask-about-clearing? (make-check-box 'drscheme:test-coverage-ask-about-clearing?
(string-constant test-coverage-ask?) (string-constant test-coverage-ask?)
warnings-panel)))) warnings-panel))))
(drscheme:debug:add-prefs-panel) (drscheme:debug:add-prefs-panel)
(install-help-browser-preference-panel) (install-help-browser-preference-panel)
(drscheme:tools:add-prefs-panel) (drscheme:tools:add-prefs-panel)
(drscheme:language:register-capability 'drscheme:autocomplete-words (listof string?) '()) (drscheme:language:register-capability 'drscheme:autocomplete-words (listof string?) '())
(drscheme:language:register-capability 'drscheme:define-popup (drscheme:language:register-capability 'drscheme:define-popup
(or/c (cons/c string? string?) false/c) (or/c (cons/c string? string?) false/c)
(cons "(define" "(define ...)")) (cons "(define" "(define ...)"))
(drscheme:language:register-capability 'drscheme:special:insert-fraction (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-fraction (flat-contract boolean?) #t)
(drscheme:language:register-capability 'drscheme:special:insert-large-letters (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-large-letters (flat-contract boolean?) #t)
(drscheme:language:register-capability 'drscheme:special:insert-lambda (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-lambda (flat-contract boolean?) #t)
(drscheme:language:register-capability 'drscheme:special:insert-image (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-image (flat-contract boolean?) #t)
(drscheme:language:register-capability 'drscheme:special:insert-comment-box (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-comment-box (flat-contract boolean?) #t)
(drscheme:language:register-capability 'drscheme:language-menu-title (drscheme:language:register-capability 'drscheme:language-menu-title
(flat-contract string?) (flat-contract string?)
(string-constant scheme-menu-name)) (string-constant scheme-menu-name))
(drscheme:language:register-capability 'drscheme:teachpack-menu-items (drscheme:language:register-capability 'drscheme:teachpack-menu-items
(or/c false/c (flat-contract drscheme:unit:teachpack-callbacks?)) (or/c false/c (flat-contract drscheme:unit:teachpack-callbacks?))
#f) #f)
(handler:current-create-new-window (handler:current-create-new-window
(let ([drscheme-current-create-new-window (let ([drscheme-current-create-new-window
(λ (filename) (λ (filename)
(drscheme:unit:open-drscheme-window filename))]) (drscheme:unit:open-drscheme-window filename))])
drscheme-current-create-new-window)) drscheme-current-create-new-window))
;; add a catch-all handler to open drscheme files ;; add a catch-all handler to open drscheme files
(handler:insert-format-handler (handler:insert-format-handler
"Units" "Units"
(λ (filename) #t) (λ (filename) #t)
drscheme:unit:open-drscheme-window) drscheme:unit:open-drscheme-window)
;; add a handler to open .plt files. ;; add a handler to open .plt files.
(handler:insert-format-handler (handler:insert-format-handler
"PLT Files" "PLT Files"
(λ (filename) (λ (filename)
(let ([ext (filename-extension filename)]) (let ([ext (filename-extension filename)])
@ -332,34 +328,34 @@
(run-installer filename) (run-installer filename)
#f)) #f))
(drscheme:tools:load/invoke-all-tools (drscheme:tools:load/invoke-all-tools
(λ () (void)) (λ () (void))
(λ () (λ ()
(drscheme:language-configuration:add-built-in-languages) (drscheme:language-configuration:add-built-in-languages)
(drscheme:module-language:add-module-language) (drscheme:module-language:add-module-language)
(drscheme:language-configuration:add-info-specified-languages))) (drscheme:language-configuration:add-info-specified-languages)))
;; no more extension after this point ;; no more extension after this point
(drscheme:get/extend:get-interactions-canvas) (drscheme:get/extend:get-interactions-canvas)
(drscheme:get/extend:get-definitions-canvas) (drscheme:get/extend:get-definitions-canvas)
(drscheme:get/extend:get-unit-frame) (drscheme:get/extend:get-unit-frame)
(drscheme:get/extend:get-interactions-text) (drscheme:get/extend:get-interactions-text)
(drscheme:get/extend:get-definitions-text) (drscheme:get/extend:get-definitions-text)
(drscheme:language-configuration:get-languages) (drscheme:language-configuration:get-languages)
;; this default can only be set *after* the ;; this default can only be set *after* the
;; languages have all be registered by tools ;; languages have all be registered by tools
(preferences:set-default (preferences:set-default
drscheme:language-configuration:settings-preferences-symbol drscheme:language-configuration:settings-preferences-symbol
(drscheme:language-configuration:get-default-language-settings) (drscheme:language-configuration:get-default-language-settings)
drscheme:language-configuration:language-settings?) drscheme:language-configuration:language-settings?)
;; if the unmarshaller returns #f, that will fail the ;; if the unmarshaller returns #f, that will fail the
;; test for this preference, reverting back to the default. ;; test for this preference, reverting back to the default.
;; In that case, the default is specified in the pref.ss file ;; In that case, the default is specified in the pref.ss file
;; of the default collection and may not be the default ;; of the default collection and may not be the default
;; specified above (of course). ;; specified above (of course).
(preferences:set-un/marshall (preferences:set-un/marshall
drscheme:language-configuration:settings-preferences-symbol drscheme:language-configuration:settings-preferences-symbol
(λ (x) (λ (x)
(let ([lang (drscheme:language-configuration:language-settings-language x)] (let ([lang (drscheme:language-configuration:language-settings-language x)]
@ -387,7 +383,7 @@
lang lang
(or settings (send lang default-settings))))))))) (or settings (send lang default-settings)))))))))
(let ([drs-handler-recent-items-super% (let ([drs-handler-recent-items-super%
(class (drscheme:frame:basics-mixin (class (drscheme:frame:basics-mixin
(frame:standard-menus-mixin (frame:standard-menus-mixin
frame:basic%)) frame:basic%))
@ -396,7 +392,7 @@
(super-new))]) (super-new))])
(handler:set-recent-items-frame-superclass drs-handler-recent-items-super%)) (handler:set-recent-items-frame-superclass drs-handler-recent-items-super%))
(cond (cond
[(current-eventspace-has-menu-root?) [(current-eventspace-has-menu-root?)
(drscheme:frame:create-root-menubar) (drscheme:frame:create-root-menubar)
(preferences:set 'framework:exit-when-no-frames #f)] (preferences:set 'framework:exit-when-no-frames #f)]
@ -404,7 +400,7 @@
(preferences:set 'framework:exit-when-no-frames #t)]) (preferences:set 'framework:exit-when-no-frames #t)])
(let* ([sl (editor:get-standard-style-list)] (let* ([sl (editor:get-standard-style-list)]
[sd (make-object style-delta%)]) [sd (make-object style-delta%)])
(send sd set-delta-foreground (make-object color% 255 0 0)) (send sd set-delta-foreground (make-object color% 255 0 0))
(send sl new-named-style (send sl new-named-style
@ -412,23 +408,23 @@
(send sl find-or-create-style (send sl find-or-create-style
(send sl find-named-style "text:ports err") (send sl find-named-style "text:ports err")
sd))) sd)))
(define repl-error-pref 'drscheme:read-eval-print-loop:error-color) (define repl-error-pref 'drscheme:read-eval-print-loop:error-color)
(define repl-out-pref 'drscheme:read-eval-print-loop:out-color) (define repl-out-pref 'drscheme:read-eval-print-loop:out-color)
(define repl-value-pref 'drscheme:read-eval-print-loop:value-color) (define repl-value-pref 'drscheme:read-eval-print-loop:value-color)
(color-prefs:register-color-preference repl-value-pref (color-prefs:register-color-preference repl-value-pref
"text:ports value" "text:ports value"
(make-object color% 0 0 175) (make-object color% 0 0 175)
(make-object color% 57 89 216)) (make-object color% 57 89 216))
(color-prefs:register-color-preference repl-error-pref (color-prefs:register-color-preference repl-error-pref
"text:ports err" "text:ports err"
(let ([sd (make-object style-delta% 'change-italic)]) (let ([sd (make-object style-delta% 'change-italic)])
(send sd set-delta-foreground (make-object color% 255 0 0)) (send sd set-delta-foreground (make-object color% 255 0 0))
sd)) sd))
(color-prefs:register-color-preference repl-out-pref (color-prefs:register-color-preference repl-out-pref
"text:ports out" "text:ports out"
(make-object color% 150 0 150) (make-object color% 150 0 150)
(make-object color% 192 46 214)) (make-object color% 192 46 214))
(color-prefs:add-to-preferences-panel (color-prefs:add-to-preferences-panel
(string-constant repl-colors) (string-constant repl-colors)
(λ (parent) (λ (parent)
(color-prefs:build-color-selection-panel parent (color-prefs:build-color-selection-panel parent
@ -444,20 +440,20 @@
"text:ports out" "text:ports out"
(string-constant repl-out-color)))) (string-constant repl-out-color))))
;; Check for any files lost last time. ;; Check for any files lost last time.
;; Ignore the framework's empty frames test, since ;; Ignore the framework's empty frames test, since
;; the autosave information window may appear and then ;; the autosave information window may appear and then
;; go away (leaving no frames temporarily) but we are ;; go away (leaving no frames temporarily) but we are
;; not going to be exiting yet. ;; not going to be exiting yet.
(autosave:restore-autosave-files/gui) (autosave:restore-autosave-files/gui)
;; install user's keybindings ;; install user's keybindings
(for-each drscheme:frame:add-keybindings-item (for-each drscheme:frame:add-keybindings-item
(preferences:get 'drscheme:user-defined-keybindings)) (preferences:get 'drscheme:user-defined-keybindings))
;; the initial window doesn't set the ;; the initial window doesn't set the
;; unit object's state correctly, yet. ;; unit object's state correctly, yet.
(define (make-basic) (define (make-basic)
(let* ([frame (drscheme:unit:open-drscheme-window)] (let* ([frame (drscheme:unit:open-drscheme-window)]
[interactions-edit (send frame get-interactions-text)] [interactions-edit (send frame get-interactions-text)]
[definitions-edit (send frame get-interactions-text)] [definitions-edit (send frame get-interactions-text)]
@ -467,7 +463,7 @@
(send (send frame get-interactions-canvas) focus)) (send (send frame get-interactions-canvas) focus))
(send frame show #t))) (send frame show #t)))
(define (remove-duplicates files) (define (remove-duplicates files)
(let loop ([files files]) (let loop ([files files])
(cond (cond
[(null? files) null] [(null? files) null]
@ -475,9 +471,9 @@
(loop (cdr files)) (loop (cdr files))
(cons (car files) (loop (cdr files))))]))) (cons (car files) (loop (cdr files))))])))
;; NOTE: drscheme-normal.ss sets current-command-line-arguments to ;; NOTE: drscheme-normal.ss sets current-command-line-arguments to
;; the list of files to open, after parsing out flags like -h ;; the list of files to open, after parsing out flags like -h
(let* ([files-to-open (let* ([files-to-open
(if (preferences:get 'drscheme:open-in-tabs) (if (preferences:get 'drscheme:open-in-tabs)
(vector->list (current-command-line-arguments)) (vector->list (current-command-line-arguments))
(reverse (vector->list (current-command-line-arguments))))] (reverse (vector->list (current-command-line-arguments))))]

11
collects/mrlib/interactive-value-port.ss
View File

@ -41,7 +41,16 @@
(not (integer? x)))) (not (integer? x))))
(define (do-printing pretty value port) (define (do-printing pretty value port)
(parameterize ([pretty-print-columns 'infinity] (parameterize (;; these three handlers aren't used, but are set to override the user's settings
[pretty-print-print-line (λ (line-number op old-line dest-columns)
(when (and (not (equal? line-number 0))
(not (equal? dest-columns 'infinity)))
(newline op))
0)]
[pretty-print-pre-print-hook (λ (val port) (void))]
[pretty-print-post-print-hook (λ (val port) (void))]
[pretty-print-columns 'infinity]
[pretty-print-size-hook [pretty-print-size-hook
(λ (value display? port) (λ (value display? port)
(cond (cond