From 571bb5fb1ac7fdc16e851720c88e81efbb8456fb Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 2 Jun 2013 21:46:21 -0500 Subject: [PATCH] adjust DrRacket to still start up if all of the splash-related images are broken I don't know if this really closes PR 13794 but DrRacket does now pass the error given in that PR. --- collects/drracket/private/drracket-normal.rkt | 48 ++++++++++++++----- collects/framework/splash.rkt | 3 -- .../tests/drracket/private/easter-egg-lib.rkt | 11 ++++- 3 files changed, 46 insertions(+), 16 deletions(-) diff --git a/collects/drracket/private/drracket-normal.rkt b/collects/drracket/private/drracket-normal.rkt index b1ac892500..e3d2d031b5 100644 --- a/collects/drracket/private/drracket-normal.rkt +++ b/collects/drracket/private/drracket-normal.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require mred +(require racket/gui/base racket/class racket/cmdline racket/list @@ -8,6 +8,7 @@ framework/splash racket/runtime-path racket/file + (for-syntax racket/base) "frame-icon.rkt" "eb.rkt") @@ -22,6 +23,24 @@ (string->number ssec) (current-seconds))))) +(define-syntax (def-imgs stx) + (syntax-case stx () + [(_ img ...) + (with-syntax ([(str ...) (map (compose symbol->string syntax-e) + (syntax->list #'(img ...)))]) + #'(begin (define img str) ... + (when (getenv "PLTDRBREAKIMAGES") + (set! img (string-append "PLTDRBREAKIMAGES-dne-" img)) ...)))])) + +(def-imgs + plt-logo-red-shiny.png + plt-logo-red-diffuse.png + heart.png + texas-plt-bw.gif + PLT-pumpkin.png + PLT-206-larval.png + PLT-206-mars.jpg) + ;; updates the command-line-arguments with only the files ;; to open. See also main.rkt. (current-command-line-arguments (apply vector files-to-open)) @@ -62,8 +81,8 @@ ;; magic strings and their associated images. There should not be a string ;; in this list that is a prefix of another. (define magic-images - (list #;(magic-img "larval" "PLT-206-larval.png") - (magic-img "mars" "PLT-206-mars.jpg"))) + (list #;(magic-img "larval" PLT-206-larval.png) + (magic-img "mars" PLT-206-mars.jpg))) (define (load-magic-images) (set! load-magic-images void) ; run only once @@ -114,9 +133,9 @@ (when (eb-bday?) (install-eb)) -(define weekend-bitmap-spec (collection-file-path "plt-logo-red-shiny.png" "icons")) -(define normal-bitmap-spec (collection-file-path "plt-logo-red-diffuse.png" "icons")) -(define valentines-days-spec (collection-file-path "heart.png" "icons")) +(define weekend-bitmap-spec (collection-file-path plt-logo-red-shiny.png "icons" #:fail (λ (x) plt-logo-red-shiny.png))) +(define normal-bitmap-spec (collection-file-path plt-logo-red-diffuse.png "icons" #:fail (λ (x) plt-logo-red-diffuse.png))) +(define valentines-days-spec (collection-file-path heart.png "icons" #:fail (λ (x) heart.png))) (define the-bitmap-spec (cond @@ -129,14 +148,19 @@ size size))] [texas-independence-day? - (collection-file-path "texas-plt-bw.gif" "icons")] + (collection-file-path texas-plt-bw.gif "icons")] [halloween? - (collection-file-path "PLT-pumpkin.png" "icons")] + (collection-file-path PLT-pumpkin.png "icons")] [(weekend-date? startup-date) weekend-bitmap-spec] [else normal-bitmap-spec])) -(define the-splash-bitmap (and (path? the-bitmap-spec) (read-bitmap the-bitmap-spec))) +(define (read-bitmap/no-crash fn) + (with-handlers ((exn:fail? (λ (x) (make-object bitmap% "dne.png")))) + (read-bitmap fn))) + +(define the-splash-bitmap (and (path? the-bitmap-spec) + (read-bitmap/no-crash the-bitmap-spec))) (set-splash-char-observer drracket-splash-char-observer) (when (eq? (system-type) 'macosx) @@ -154,13 +178,13 @@ (define (set-icon state) (case state [(valentines) - (unless valentines-bitmap (set! valentines-bitmap (read-bitmap valentines-days-spec))) + (unless valentines-bitmap (set! valentines-bitmap (read-bitmap/no-crash valentines-days-spec))) (set-doc-tile-bitmap valentines-bitmap)] [(weekend) - (unless weekend-bitmap (set! weekend-bitmap (read-bitmap weekend-bitmap-spec))) + (unless weekend-bitmap (set! weekend-bitmap (read-bitmap/no-crash weekend-bitmap-spec))) (set-doc-tile-bitmap weekend-bitmap)] [(normal) - (unless weekday-bitmap (set! weekday-bitmap (read-bitmap normal-bitmap-spec))) + (unless weekday-bitmap (set! weekday-bitmap (read-bitmap/no-crash normal-bitmap-spec))) (set-doc-tile-bitmap weekday-bitmap)])) (set-icon initial-state) (void diff --git a/collects/framework/splash.rkt b/collects/framework/splash.rkt index 92303af4f1..e98e246b3d 100644 --- a/collects/framework/splash.rkt +++ b/collects/framework/splash.rkt @@ -157,8 +157,6 @@ (let/ec k (define (no-splash) (set! splash-bitmap #f) - (set! splash-canvas #f) - (set! splash-eventspace #f) (k (void))) (send (get-gauge) set-range splash-max-width) (send splash-tlw set-label splash-title) @@ -187,7 +185,6 @@ (set! splash-bitmap splash-draw-spec)]) (unless (send splash-bitmap ok?) - (eprintf "WARNING: bad bitmap ~s\n" splash-draw-spec) (no-splash)) (send splash-canvas min-width (send splash-bitmap get-width)) diff --git a/collects/tests/drracket/private/easter-egg-lib.rkt b/collects/tests/drracket/private/easter-egg-lib.rkt index 4d63e6c96f..ea34f5545b 100644 --- a/collects/tests/drracket/private/easter-egg-lib.rkt +++ b/collects/tests/drracket/private/easter-egg-lib.rkt @@ -23,7 +23,16 @@ (printf "trying ~a, ~a/~a PLTDREASTERSECONDS=~a\n" what month day the-seconds) (unless (putenv "PLTDREASTERSECONDS" (number->string the-seconds)) (error 'easter-egg-lib.rkt "putenv failed")) - (start-up-and-check-car)) + (start-up-and-check-car) + + ;; start up with (an approximation to) broken image files + (unless (putenv "PLTDRBREAKIMAGES" "yes") + (error 'easter-egg-lib.rkt "putenv.2 failed")) + (printf "trying ~a, ~a/~a PLTDREASTERSECONDS=~a PLTDRBREAKIMAGES=yes\n" what month day the-seconds) + (start-up-and-check-car) + (environment-variables-set! (current-environment-variables) + #"PLTDRBREAKIMAGES" + #f)) (define (start-up-and-check-car) (fire-up-separate-drracket-and-run-tests