From f0f27e2e2c5761659a85486ca9ca916310bc22c5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 21 Apr 2008 19:00:18 +0000
Subject: [PATCH] removed mz,mred,slideshow languages and made module
 language's initial REPL be scheme/base instead of mzscheme

svn: r9384
---
 .../private/language-configuration.ss         |  33 +-
 collects/drscheme/private/module-language.ss  |   2 +-
 collects/slideshow/tool.ss                    | 564 +-----------------
 .../danish-string-constants.ss                |   4 -
 .../english-string-constants.ss               |   4 -
 .../french-string-constants.ss                |   4 -
 .../german-string-constants.ss                |   4 -
 .../japanese-string-constants.ss              |   4 -
 .../portuguese-string-constants.ss            |   4 -
 .../spanish-string-constants.ss               |   4 -
 10 files changed, 4 insertions(+), 623 deletions(-)

diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss
index f9e638d99a..a93bf11bcb 100644
--- a/collects/drscheme/private/language-configuration.ss
+++ b/collects/drscheme/private/language-configuration.ss
@@ -1385,46 +1385,15 @@
                     (language-id id)
                     (language-position position)
                     (language-numbers numbers))))])
-        (add-language
-         (make-simple '(lib "lang/plt-mzscheme.ss")
-                      "plt:mz"
-                      (list (string-constant legacy-languages)
-                            (string-constant plt)
-                            (string-constant mzscheme-w/debug))
-                      (list -1000 -10 1)
-                      #f
-                      (string-constant mzscheme-one-line-summary)
-                      (λ (x) x)))
-        (add-language
-         (make-simple '(lib "lang/plt-mred.ss")
-                      "plt:mred"
-                      (list (string-constant legacy-languages)
-                            (string-constant plt)
-                            (string-constant mred-w/debug))
-                      (list -1000 -10 2)
-                      #t
-                      (string-constant mred-one-line-summary)
-                      (λ (x) x)))
         (add-language
          (make-simple '(lib "lang/plt-pretty-big.ss")
                       "plt:pretty-big"
                       (list (string-constant legacy-languages)
-                            (string-constant plt)
                             (string-constant pretty-big-scheme))
-                      (list -1000 -10 3)
+                      (list -1000 3)
                       #t
                       (string-constant pretty-big-scheme-one-line-summary)
                       (λ (x) x)))
-        (add-language
-         (make-simple '(lib "lang/plt-mzscheme.ss")
-                      "plt:expander"
-                      (list (string-constant legacy-languages)
-                            (string-constant plt)
-                            (string-constant expander))
-                      (list -1000 -10 4)
-                      #t
-                      (string-constant expander-one-line-summary)
-                      add-expand-to-front-end))
         (add-language
          (make-simple '(lib "r5rs/lang.ss")
                       "plt:r5rs"
diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss
index 843560dbf1..3f74c5e624 100644
--- a/collects/drscheme/private/module-language.ss
+++ b/collects/drscheme/private/module-language.ss
@@ -223,7 +223,7 @@
                                        executable-filename))))))))
         
         (super-new
-         (module '(lib "plt-mred.ss" "lang"))
+         (module 'scheme/base)
          (language-position (list "Module"))
          (language-numbers (list -32768)))))
     
diff --git a/collects/slideshow/tool.ss b/collects/slideshow/tool.ss
index 07adebe5a3..946e5b68de 100644
--- a/collects/slideshow/tool.ss
+++ b/collects/slideshow/tool.ss
@@ -2,13 +2,6 @@
 
 todo:
 
-slideshow language:
-- handle ranges (just the first letter of an identifier), 
-- show/hide menu in the wrong place
-- dock/undock the preview window
-- editing should make the annotations disappear (need to extend the program mixin)
-- move calls to draw-pict over to user's eventspace
-
 pict snip :
 - snipclass for running snips outside of drscheme
 - need to toggle the picts back to scheme code when
@@ -58,10 +51,6 @@ pict snip :
       (define original-output-port (current-output-port))
       (define (oprintf . args) (apply fprintf original-output-port args))
       
-      (define sc-show-slideshow-panel (string-constant slideshow-show-slideshow-panel))
-      (define sc-hide-slideshow-panel (string-constant slideshow-hide-slideshow-panel))
-      (define sc-freeze-picts (string-constant slideshow-freeze-picts))
-      (define sc-thaw-picts (string-constant slideshow-thaw-picts))
       (define sc-hide-picts (string-constant slideshow-hide-picts))
       (define sc-show-picts (string-constant slideshow-show-picts))
       (define sc-cannot-show-picts (string-constant slideshow-cannot-show-picts))
@@ -330,559 +319,13 @@ pict snip :
                (insert-snip 
                 (lambda () (new pict-snip%))))))))
       
-      
-      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;;
-      ;;  drscheme extensions
-      ;;
-      
-      (define-struct p (pict-drawer width height n))
-      (define new-p
-        (let ([c 0])
-          (lambda (pd w h)
-            (set! c (+ c 1))
-            (make-p pd w h c))))
-      
-      (define show-picts<%>
-        (interface ()
-          slideshow:register-pict))
-      
-      (define show-picts-mixin
-        (mixin (color:text<%> editor<%>) (show-picts<%>)
-          (inherit get-canvas freeze-colorer)
-          
-          ;; all-picts-ht : hash-table[(cons text% number) -op> hash-table[pict -o> p]]
-          ;; the inner hashtables are really treated as sets, using the pict as
-          ;; the equality measure.
-          (define all-picts-ht (make-hash-table 'equal))
-          
-          (define frozen-colorers (make-hash-table))
-          
-          (define mouse-loc #f)
-          (define visible-picts #f)
-          
-          (define/public (slideshow:clear-picts)
-            (set! all-picts-ht (make-hash-table 'equal))
-            (hash-table-for-each
-             frozen-colorers
-             (lambda (k v)
-               (send k thaw-colorer)))
-            (set! frozen-colorers (make-hash-table)))
-          
-          (define/public (slideshow:register-pict text offset range pict pict-drawer width height)
-            (hash-table-get frozen-colorers
-                            text
-                            (lambda ()
-                              (when (is-a? text color:text<%>)
-                                (let ([locked? (send text is-locked?)])
-                                  (send text lock #f)
-                                  (send text freeze-colorer)
-                                  (send text lock locked?))
-                                (hash-table-put! frozen-colorers text #t))))
-            (let ([locked? (send text is-locked?)])
-              (send text lock #f)
-              (send text change-style has-info-style offset (+ offset 1) #f)
-              (send text lock locked?))
-            (let* ([key (cons text offset)]
-                   [picts-ht
-                    (hash-table-get all-picts-ht 
-                                    key
-                                    (lambda ()
-                                      (let ([new-ht (make-hash-table)])
-                                        (hash-table-put! all-picts-ht key new-ht)
-                                        new-ht)))])
-              ;; store the new pict in the hash-table, unless it is already in there,
-              ;; in which case we leave the current one (so we don't get a new number)
-              (hash-table-get
-               picts-ht
-               pict
-               (lambda ()
-                 (hash-table-put!
-                  picts-ht
-                  pict
-                  (new-p pict-drawer width height))))))
-          
-          (define/override (on-event evt)
-            (cond
-              [(send evt leaving?)
-               (update-mouse #f #f)
-               (super on-event evt)]
-              [(or (send evt moving?)
-                   (send evt entering?))
-               (let-values ([(pos text) (get-pos/text evt)])
-                 (update-mouse text pos))
-               (super on-event evt)]
-              [(send evt button-down? 'right)
-               (let-values ([(pos text) (get-pos/text evt)])
-                 (if (and pos text)
-                     (unless (show-menu evt text pos)
-                       (super on-event evt))
-                     (super on-event evt)))]
-              [else
-               (super on-event evt)]))
-          
-          ;; show-menu : ... -> boolean
-          ;; result indicates if a menu was shown
-          (define/private (show-menu evt text pos)
-            (let ([frame (let ([canvas (get-canvas)])
-                           (and canvas
-                                (send canvas get-top-level-window)))])
-              (and frame
-                   (let ([admin (send text get-admin)]
-                         [menu (new popup-menu%)]
-                         [show? #f])
-                     (let* ([frozen-mouse-picts-key (cons text pos)]
-                            [picts-ht (hash-table-get all-picts-ht frozen-mouse-picts-key (lambda () #f))])
-                       (when picts-ht
-                         (let ([picts (get-all-ps-from-ht picts-ht)])
-                           (set! show? #t)
-                           (new menu-item%
-                                (label sc-freeze-picts)
-                                (parent menu)
-                                (callback
-                                 (lambda (x y)
-                                   (send frame slideshow:set-permanent-picts picts)))))))
-                     (when (send frame slideshow:has-permanent-picts?)
-                       (new menu-item%
-                            (label sc-thaw-picts)
-                            (parent menu)
-                            (callback
-                             (lambda (x y)
-                               (send frame slideshow:set-permanent-picts #f))))
-                       (set! show? #t))
-                     (and show?
-                          (begin
-                            (send admin popup-menu 
-                                  menu
-                                  (send evt get-x)
-                                  (send evt get-y))
-                            #t))))))
-            
-          (define/private (update-mouse text pos)
-            (let ([new-mouse-loc (and text pos (cons text pos))])
-              (unless (equal? new-mouse-loc mouse-loc)
-                (set! mouse-loc new-mouse-loc)
-                (let ([frame (let ([canvas (get-canvas)])
-                               (and canvas
-                                    (send canvas get-top-level-window)))])
-                  (when frame
-                    (send frame slideshow:set-visible-picts
-                          (and pos 
-                               text 
-                               (let ([picts-ht
-                                      (hash-table-get all-picts-ht new-mouse-loc (lambda () #f))])
-                                 (and picts-ht
-                                      (get-all-ps-from-ht picts-ht))))))))))
-          
-          (define/private (get-all-ps-from-ht picts-ht)
-            (let ([ps (hash-table-map picts-ht (lambda (k v) v))])
-              (sort ps (lambda (x y) (<= (p-n x) (p-n y))))))
-
-          ;; get-pos/text : event -> (values (union #f text%) (union number #f))
-          ;; returns two #fs to indicate the event doesn't correspond to
-          ;; a position in an editor, or returns the innermost text
-          ;; and position in that text where the event is.
-          (define/private (get-pos/text event)
-            (let ([event-x (send event get-x)]
-                  [event-y (send event get-y)]
-                  [on-it? (box #f)])
-              (let loop ([editor this])
-                (let-values ([(x y) (send editor dc-location-to-editor-location event-x event-y)])
-                  (cond
-                    [(is-a? editor text%)
-                     (let ([pos (send editor find-position x y #f on-it?)])
-                       (cond
-                         [(not (unbox on-it?)) (values #f #f)]
-                         [else
-                          (let ([snip (send editor find-snip pos 'after-or-none)])
-                            (if (and snip
-                                     (is-a? snip editor-snip%))
-                                (loop (send snip get-editor))
-                                (values pos editor)))]))]
-                    [(is-a? editor pasteboard%)
-                     (let ([snip (send editor find-snip x y)])
-                       (if (and snip
-                                (is-a? snip editor-snip%))
-                           (loop (send snip get-editor))
-                           (values #f #f)))]
-                    [else (values #f #f)])))))
-          
-          (super-new)))
-      
-      (define has-info-style (make-object style-delta%))
-      (send has-info-style set-delta-background "black")
-      (send has-info-style set-transparent-text-backing-off #t)
-      (send has-info-style set-delta-foreground "hotpink")
-      
-      (define tab-mixin
-        (mixin (drscheme:rep:context<%> drscheme:unit:tab<%>) ()
-          (inherit get-defs get-ints)
-          (define/augment (clear-annotations)
-            (send (get-defs) slideshow:clear-picts)
-            (send (get-ints) slideshow:clear-picts)
-            (inner (void) clear-annotations))
-          (super-new)))
-      
-      (define unit-frame-mixin
-        (mixin (drscheme:unit:frame<%>) ()
-          (inherit get-show-menu)
-          
-          (define slideshow-parent-panel #f)
-          (define everything-else-panel #f)
-          (define slideshow-panel #f)
-          (define slideshow-canvas #f)
-          (define slideshow-panel-visible? #f)
-          
-          (define permanent-picts #f)
-          (define visible-picts #f)
-          
-          (define/public (slideshow:set-visible-picts picts)
-            (unless (equal? picts visible-picts)
-              (set! visible-picts picts)
-              (when slideshow-panel-visible?
-                (draw-picts (send slideshow-canvas get-dc)))))
-          
-          (define/public (slideshow:set-permanent-picts picts)
-            (set! permanent-picts picts)
-            (if picts
-                (send slideshow-canvas 
-                      init-auto-scrollbars
-                      (inexact->exact (floor (apply max (map p-width picts))))
-                      (inexact->exact (floor (apply + (map p-height picts))))
-                      0
-                      0)
-                (send slideshow-canvas init-auto-scrollbars #f #f 0 0)))
-          (define/public (slideshow:has-permanent-picts?) permanent-picts)
-          
-          (define/override (make-root-area-container cls parent)
-            (set! slideshow-parent-panel (super make-root-area-container slideshow-dragable% parent))
-            (let ([root (make-object cls slideshow-parent-panel)])
-              (set! everything-else-panel root)
-              root))
-          
-          (define/override (update-shown)
-            (super update-shown)
-            (if slideshow-panel-visible?
-                (begin
-                  (send slideshow-parent-panel begin-container-sequence)
-		  (unless slideshow-panel (build-slideshow-panel))
-                  (when (is-a? view-menu-item menu-item%)
-                    (send view-menu-item set-label sc-hide-slideshow-panel))
-		  (send slideshow-parent-panel
-                        change-children
-                        (lambda (l)
-                          (list everything-else-panel slideshow-panel)))
-		  (send slideshow-parent-panel end-container-sequence))
-                (begin
-                  (when (is-a? view-menu-item menu-item%)
-                    (send view-menu-item set-label sc-show-slideshow-panel))
-                  (send slideshow-parent-panel
-                        change-children
-                        (lambda (l)
-                          (list everything-else-panel))))))
-          
-          (define/private (build-slideshow-panel)
-            (let ([p (preferences:get 'plt:slideshow:panel-percentage)])
-              ;; must save the value of the pref before creating slideshow-panel
-              ;; so that the callback doesn't clobber it
-              
-              (set! slideshow-panel (new vertical-panel% (parent slideshow-parent-panel)))
-              (set! slideshow-canvas (new canvas%
-                                          (style '(hscroll vscroll))
-                                          (parent slideshow-panel)
-                                          (paint-callback
-                                           (lambda (x dc)
-                                             (draw-picts dc)))))
-              (send slideshow-parent-panel set-percentages (list p (- 1 p)))
-              (preferences:set 'plt:slideshow:panel-percentage p)))
-
-          (define/private (draw-picts dc)
-            (send dc clear)
-            (let ([picts (or permanent-picts visible-picts)])
-              (when picts
-                (let loop ([picts picts]
-                           [y 0])
-                  (cond
-                    [(null? picts) (void)]
-                    [else (let ([pict (car picts)])
-                            ((p-pict-drawer pict) dc 0 y)
-                            (loop (cdr picts)
-                                  (+ y (p-height pict))))])))))
-          
-          (define/override (add-show-menu-items show-menu)
-            (super add-show-menu-items show-menu)
-            (set! view-menu-item
-                  (new menu-item%
-                       (label sc-show-slideshow-panel)
-                       (parent (get-show-menu))
-                       (callback
-                        (lambda (x y)
-                          (set! slideshow-panel-visible? (not slideshow-panel-visible?))
-                          (update-shown))))))
-          
-          (define view-menu-item #f)
-          
-          (super-new)
-          
-          (inherit get-insert-menu register-capability-menu-item)
-          (add-special-menu-item (get-insert-menu) this)
-          (register-capability-menu-item 'drscheme:special:slideshow-menu-item (get-insert-menu))))
-      
-      (define slideshow-dragable%
-        (class panel:horizontal-dragable%
-          (inherit get-percentages)
-          (define/augment (after-percentage-change)
-            (let ([percentages (get-percentages)])
-              (when (= 2 (length percentages))
-                (preferences:set 'plt:slideshow:panel-percentage (car percentages))))
-            (inner (void) after-percentage-change))
-          (super-new)))
-
-      (define has-info-bkg-color (make-object color% "gray"))
-      
-      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;;
-      ;; preference defaults
-      ;;
-      
-      ;; size of the drscheme window.
-      (preferences:set-default 'plt:slideshow:panel-percentage 3/4 (lambda (x) (and (number? x) (<= 0 x 1))))
-
-      (drscheme:language:register-capability 'drscheme:special:slideshow-menu-item (flat-contract boolean?) #t)
-      
-      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;;
-      ;;  communication from user thread to drscheme's repl
-      ;;
-            
-      (define system-eventspace (current-eventspace))
-
-      ;; send-over : any syntax -> void
-      ;; thread: (any) user's thread
-      (define (send-over v stx)
-        (let ([rep (drscheme:rep:current-rep)])
-          (when rep
-            (when (pict? v)
-              (let ([pict-drawer (make-pict-drawer v)]
-                    [width (pict-width v)]
-                    [height (pict-height v)])
-                (parameterize ([current-eventspace system-eventspace])
-                  (queue-callback
-                   (lambda ()
-                     (add-pict-drawer stx v pict-drawer width height)))))))))
-      
-      ;; add-pict-drawer : syntax pict-drawer number number -> void
-      ;; thread: system eventspace
-      (define (add-pict-drawer stx pict pict-drawer width height)
-        (let ([src (syntax-source stx)]
-              [offset (syntax-position stx)]
-              [span (syntax-span stx)])
-          (when (and (is-a? src editor<%>)
-                     (number? offset)
-                     (number? span))
-            (let ([top-most (let loop ([src src])
-                              (let ([admin (send src get-admin)])
-                                (cond
-                                  [(not admin) #f]
-                                  [(is-a? admin editor-snip-editor-admin<%>)
-                                   (let* ([outer-editor-snip (send admin get-snip)]
-                                          [es-admin (send outer-editor-snip get-admin)]
-                                          [outer-editor (send es-admin get-editor)])
-                                     (loop outer-editor))]
-                                  [else src])))])
-              (when (is-a? top-most show-picts<%>)
-                (send top-most slideshow:register-pict src (- offset 1) span pict pict-drawer width height))))))
-      
-      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-      ;;
-      ;; slideshow lang
-      ;;
-      
-      (define slideshow-mixin
-        (mixin (drscheme:language:language<%>) ()
-          (define/override (front-end/complete-program input settings)
-            (let ([st (super front-end/complete-program input settings)])
-              (lambda ()
-                (let ([sv (st)])
-                  (cond
-                    [(syntax? sv) (rewrite-syntax sv)]
-                    [else sv])))))
-          (define/override (front-end/interaction input settings)
-            (let ([st (super front-end/interaction input settings)])
-              (lambda ()
-                (let ([sv (st)])
-                  (cond
-                    [(syntax? sv) (rewrite-syntax sv)]
-                    [else sv])))))
-          (define/override (get-language-name) "Slideshow")
-          (super-new (module '(lib "plt-mred.ss" "lang"))
-                     (language-position (list (string-constant experimental-languages)
-                                              "Slideshow"))
-                     (language-numbers (list 1000 341)))))
-      
-      (define (rewrite-syntax stx)
-        (rewrite-top-level (expand stx)))
-      
-      (define (rewrite-top-level stx)
-        (syntax-case stx (module begin)
-          [(module identifier name (#%plain-module-begin module-level-expr ...))
-           (with-syntax ([(rewritten-module-level-expr ...) (map rewrite-module-level
-                                                                 (syntax->list
-                                                                  (syntax (module-level-expr ...))))])
-             (syntax/cert stx (module identifier name (#%plain-module-begin rewritten-module-level-expr ...))))]
-          [(begin top-level-expr ...)
-           (with-syntax ([(rewritten-top-level-expr ...) 
-                          (map rewrite-top-level (syntax->list (syntax (top-level-expr ...))))])
-             (syntax/cert stx (begin rewritten-top-level-expr ...)))]
-          [general-top-level-expr (rewrite-general-top-level stx)]))
-
-      (define (rewrite-module-level stx)
-        (syntax-case stx (#%provide begin)
-          [(#%provide provide-spec ...) stx]
-          [(begin module-level-expr ...)
-           (with-syntax ([(rewritten-module-level-expr ...)
-                          (map rewrite-module-level 
-                               (syntax->list (syntax (module-level-expr  ...))))])
-             (syntax/cert stx (begin rewritten-module-level-expr ...)))]
-          [general-top-level-expr (rewrite-general-top-level stx)]))
-      
-      (define (rewrite-general-top-level stx)
-        (syntax-case stx (define-values define-syntaxes define-values-for-syntax #%require)
-          [(define-values (variable ...) expr)
-           (with-syntax ([rewritten-expr (add-send-over (rewrite-expr (syntax expr)) 
-                                                        (syntax expr) 
-                                                        (length (syntax->list (syntax (variable ...)))))])
-             (syntax/cert stx (define-values (variable ...) rewritten-expr)))]
-          [(define-syntaxes (variable ...) expr) stx]
-          [(define-values-for-syntax (variable ...) expr) stx]
-          [(#%require require-spec ...) stx]
-          [expr (rewrite-expr stx)]))
-      
-      (define (rewrite-expr stx)
-        (syntax-case stx (lambda case-lambda if begin begin0 let-values letrec-values set! quote quote-syntax 
-				 with-continuation-mark #%app #%top)
-          [variable
-           (identifier? (syntax variable))
-           (add-send-over/var (syntax variable) stx)]
-          [(lambda formals expr ...)
-           (with-syntax ([(rewritten-expr ...) 
-                          (map rewrite-expr (syntax->list (syntax (expr ...))))])
-	     (syntax/cert stx (lambda formals rewritten-expr ...)))]
-          [(case-lambda (formals expr ...) ...)
-           (with-syntax ([((rewritten-expr ...) ...)
-                          (map (lambda (exprs) (map rewrite-expr (syntax->list exprs)))
-                               (syntax->list (syntax ((expr ...) ...))))])
-             (syntax/cert stx (case-lambda (formals rewritten-expr ...) ...)))]
-          [(if expr1 expr2)
-           (with-syntax ([rewritten-expr1 (add-send-over (rewrite-expr (syntax expr1)) (syntax expr1) 1)]
-                         [rewritten-expr2 (rewrite-expr (syntax expr2))])
-             (syntax/cert stx (if rewritten-expr1 rewritten-expr2)))]
-          [(if expr1 expr2 expr3)
-           (with-syntax ([rewritten-expr1 (add-send-over (rewrite-expr (syntax expr1)) (syntax expr1) 1)]
-                         [rewritten-expr2 (rewrite-expr (syntax expr2))]
-                         [rewritten-expr3 (rewrite-expr (syntax expr3))])
-             (syntax/cert stx (if rewritten-expr1 rewritten-expr2 rewritten-expr3)))]
-          [(begin expr ... last-expr)
-           (with-syntax ([(rewritten-expr ...) (map (lambda (x) (add-send-over (rewrite-expr x) x 1))
-                                                    (syntax->list (syntax (expr ...))))]
-                         [rewritten-last-expr (rewrite-expr (syntax last-expr))])
-             (syntax/cert stx (begin rewritten-expr ... rewritten-last-expr)))]
-          [(begin0 expr ...)
-           (with-syntax ([(rewritten-expr ...) (map (lambda (x) (add-send-over (rewrite-expr x) x 1)) 
-                                                    (syntax->list (syntax (expr ...))))])
-             (syntax/cert stx (begin0 rewritten-expr ...)))]
-          [(let-values (((variable ...) v-expr) ...) expr ...)
-           (with-syntax ([(rewritten-expr ...) (map rewrite-expr (syntax->list (syntax (expr ...))))]
-                         [(rewritten-v-expr ...) (map rewrite-expr (syntax->list (syntax (v-expr ...))))]
-                         [((send-over-vars ...) ...)
-                          (map (lambda (vars)
-                                 (map (lambda (var) (add-send-over/var var var))
-                                      (syntax->list vars)))
-                               (syntax->list (syntax ((variable ...) ...))))])
-             (syntax/cert stx
-			  (let-values (((variable ...) rewritten-v-expr) ...)
-			    (begin (void) (begin (void) send-over-vars ...) ...)
-			    rewritten-expr ...)))]
-          [(letrec-values (((variable ...) v-expr) ...) expr ...)
-           (with-syntax ([(rewritten-expr ...) (map rewrite-expr (syntax->list (syntax (expr ...))))]
-                         [(rewritten-v-expr ...) (map rewrite-expr (syntax->list (syntax (v-expr ...))))]
-                         [((send-over-vars ...) ...)
-                          (map (lambda (vars)
-                                 (map (lambda (var) (add-send-over/var var var))
-                                      (syntax->list vars)))
-                               (syntax->list (syntax ((variable ...) ...))))])
-             (syntax/cert stx
-			  (letrec-values (((variable ...) rewritten-v-expr) ...)
-			    (begin (void) (begin (void) send-over-vars ...) ...)
-			    rewritten-expr ...)))]
-          [(set! variable expr)
-           (with-syntax ([rewritten-expr (add-send-over (rewrite-expr (syntax expr)) (syntax expr) 1)])
-             (syntax/cert stx (set! variable rewritten-expr)))]
-          [(quote datum) stx]
-          [(quote-syntax datum) stx]
-          [(with-continuation-mark expr1 expr2 expr3)
-           (with-syntax ([rewritten-expr1 (add-send-over (rewrite-expr (syntax expr1)) (syntax expr1) 1)]
-                         [rewritten-expr2 (add-send-over (rewrite-expr (syntax expr2)) (syntax expr2) 1)]
-                         [rewritten-expr3 (rewrite-expr (syntax expr3))])
-             (syntax/cert stx (with-continuation-mark rewritten-expr1 rewritten-expr2 rewritten-expr3)))]
-          [(#%app expr ...)
-           (with-syntax ([(rewritten-expr ...) (map (lambda (x) (add-send-over (rewrite-expr x) x 1)) 
-                                                    (syntax->list (syntax (expr ...))))])
-             (syntax/cert stx (#%app rewritten-expr ...)))]
-          [(#%expression e)
-           (with-syntax ([e (add-send-over (rewrite-expr #'x) #'x 1)])
-             (syntax/cert stx (#%expression e)))]
-          [(#%top . variable) stx]))
-      
-      (define (add-send-over stx loc-stx values-expected)
-        (if (object? (syntax-source loc-stx))
-            (with-syntax ([send-over send-over]
-                          [stx stx]
-                          [loc (datum->syntax-object loc-stx 1 loc-stx)]
-                          [(vars ...) (build-vars values-expected)])
-              (syntax
-               (let-values ([(vars ...) stx])
-                 (send-over vars #'loc) ...
-                 (values vars ...))))
-            stx))
-      (define (add-send-over/var stx loc-stx)
-        (if (object? (syntax-source loc-stx))
-            (with-syntax ([send-over send-over]
-                          [stx stx]
-                          [loc (datum->syntax-object loc-stx 1 loc-stx)])
-              (syntax
-               (begin 
-                 (send-over stx #'loc)
-                 stx)))
-            stx))
-      (define (build-vars n)
-        (cond
-          [(zero? n) #'()]
-          [else (cons (datum->syntax-object #'here (string->symbol (format "x~a" n)))
-                      (build-vars (- n 1)))]))
-
-      
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;
       ;;  wire it up
       ;;
       
-      (drscheme:get/extend:extend-interactions-text show-picts-mixin)
-      (drscheme:get/extend:extend-definitions-text show-picts-mixin)
-      (drscheme:get/extend:extend-unit-frame unit-frame-mixin)
-      (drscheme:get/extend:extend-tab tab-mixin)
-      
       (define (phase1) (void))
-      (define (phase2)
-        (define slideshow-language%
-          (slideshow-mixin
-           ((drscheme:language:get-default-mixin)
-            (drscheme:language:module-based-language->language-mixin
-             (drscheme:language:simple-module-based-language->module-based-language-mixin
-              drscheme:language:simple-module-based-language%)))))
-        
-        (drscheme:language-configuration:add-language
-         (new slideshow-language%)))
+      (define (phase2) (void))
       
       (define orig-namespace (current-namespace))
       
@@ -921,7 +364,4 @@ pict snip :
       (define lib-pict-snipclass (make-object lib-pict-snipclass%))
       (send lib-pict-snipclass set-version 2)
       (send lib-pict-snipclass set-classname (format "~s" '(lib "pict-snipclass.ss" "slideshow")))
-      (send (get-the-snip-class-list) add lib-pict-snipclass)
-
-      )))
-
+      (send (get-the-snip-class-list) add lib-pict-snipclass))))
diff --git a/collects/string-constants/danish-string-constants.ss b/collects/string-constants/danish-string-constants.ss
index b372725eb9..831e555210 100644
--- a/collects/string-constants/danish-string-constants.ss
+++ b/collects/string-constants/danish-string-constants.ss
@@ -1239,10 +1239,6 @@ please adhere to these guidelines:
   (profjBoxes-insert-java-interactions "Indsæt Java-interaktioner")
   
   ;; Slideshow
-  (slideshow-show-slideshow-panel "Vis diasshow-panel")
-  (slideshow-hide-slideshow-panel "Skjul diasshow-panel")
-  (slideshow-freeze-picts "Frys disse billeder")
-  (slideshow-thaw-picts "Vis billeder under mus")
   (slideshow-hide-picts "Vis indlejrede kasser")
   (slideshow-show-picts "Vis billeder")
   (slideshow-cannot-show-picts "Kan ikke vise billeder; kør programmet for at cache størrelserne først")
diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss
index 344d98d0af..9ead9864bd 100644
--- a/collects/string-constants/english-string-constants.ss
+++ b/collects/string-constants/english-string-constants.ss
@@ -1359,10 +1359,6 @@ please adhere to these guidelines:
   (profjBoxes-insert-java-interactions "Insert Java Interactions")
 
   ;; Slideshow
-  (slideshow-show-slideshow-panel "Show Slideshow Panel")
-  (slideshow-hide-slideshow-panel "Hide Slideshow Panel")
-  (slideshow-freeze-picts "Freeze These Picts")
-  (slideshow-thaw-picts "Show Picts Under Mouse")
   (slideshow-hide-picts "Show Nested Boxes")
   (slideshow-show-picts "Show Picts")
   (slideshow-cannot-show-picts "Cannot show picts; run program to cache sizes first")
diff --git a/collects/string-constants/french-string-constants.ss b/collects/string-constants/french-string-constants.ss
index 0f2492a17f..55cc361671 100644
--- a/collects/string-constants/french-string-constants.ss
+++ b/collects/string-constants/french-string-constants.ss
@@ -1346,10 +1346,6 @@
   (profjBoxes-insert-java-interactions "Insérer des interactions Java")
 
   ;; Slideshow
-  (slideshow-show-slideshow-panel "Montrer la sous-fenêtre Slideshow")
-  (slideshow-hide-slideshow-panel "Cacher la sous-fenêtre Slideshow")
-  (slideshow-freeze-picts "Geler ces images")
-  (slideshow-thaw-picts "Montrer les images sous la souris")
   (slideshow-hide-picts "Montrer les boîtes nichées")
   (slideshow-show-picts "Montrer les images")
   (slideshow-cannot-show-picts "Il est impossible de montrer les images; exécutez d'abord le programme pour calculer les dimensions")
diff --git a/collects/string-constants/german-string-constants.ss b/collects/string-constants/german-string-constants.ss
index ccbd8f93c8..2d4990f535 100644
--- a/collects/string-constants/german-string-constants.ss
+++ b/collects/string-constants/german-string-constants.ss
@@ -1254,10 +1254,6 @@
   (profjBoxes-insert-java-interactions "Java-Interactionen einfügen")
 
   ;; Slideshow
-  (slideshow-show-slideshow-panel "Slideshow-Panel zeigen")
-  (slideshow-hide-slideshow-panel "Slideshow Panel")
-  (slideshow-freeze-picts "Diese Picts einfrieren")
-  (slideshow-thaw-picts "Picts unter der Maus zeigen")
   (slideshow-hide-picts "Geschachtelte Kästen anzeigen")
   (slideshow-show-picts "Picts anzeigen")
   (slideshow-cannot-show-picts "Kann die Picts nicht anzeigen; Sie müssen erst das Programm zum Cachen der Größen laufen lassen")
diff --git a/collects/string-constants/japanese-string-constants.ss b/collects/string-constants/japanese-string-constants.ss
index 149a0f5617..dabe7077af 100644
--- a/collects/string-constants/japanese-string-constants.ss
+++ b/collects/string-constants/japanese-string-constants.ss
@@ -1316,10 +1316,6 @@ please adhere to these guidelines:
   (profjBoxes-insert-java-interactions "Insert Java Interactions")
 
   ;; Slideshow
-  (slideshow-show-slideshow-panel "スライドショー パネルを表示")
-  (slideshow-hide-slideshow-panel "スライドショー パネルを非表示")
-  (slideshow-freeze-picts "Freeze These Picts")
-  (slideshow-thaw-picts "Show Picts Under Mouse")
   (slideshow-hide-picts "Show Nested Boxes")
   (slideshow-show-picts "Show Picts")
   (slideshow-cannot-show-picts "Cannot show picts; run program to cache sizes first")
diff --git a/collects/string-constants/portuguese-string-constants.ss b/collects/string-constants/portuguese-string-constants.ss
index d4f0c01369..67c26be660 100644
--- a/collects/string-constants/portuguese-string-constants.ss
+++ b/collects/string-constants/portuguese-string-constants.ss
@@ -1176,10 +1176,6 @@ please adhere to these guidelines:
   (profjBoxes-insert-java-interactions "Insert Java Interactions")
 
   ;; Slideshow
-  (slideshow-show-slideshow-panel "Mostrar Painel de Apresentação")
-  (slideshow-hide-slideshow-panel "Esconder Painel de Apresentação")
-  (slideshow-freeze-picts "Congelar estas Imagens")
-  (slideshow-thaw-picts "Mostrar Imagens Debaixo do Ponteiro")
   (slideshow-hide-picts "Show Nested Boxes")
   (slideshow-show-picts "Mostrar Imagens")
   (slideshow-cannot-show-picts "Cannot show picts; run program to cache sizes first")
diff --git a/collects/string-constants/spanish-string-constants.ss b/collects/string-constants/spanish-string-constants.ss
index 5489b53184..e3de530627 100644
--- a/collects/string-constants/spanish-string-constants.ss
+++ b/collects/string-constants/spanish-string-constants.ss
@@ -1082,10 +1082,6 @@
  (profjBoxes-insert-java-interactions "Insertar Interacciones Java")
 
  ;; Slideshow
- (slideshow-show-slideshow-panel "Mostrar Panel de Slideshow")
- (slideshow-hide-slideshow-panel "Esconder Panel de Slideshow")
- (slideshow-freeze-picts "Congelar Estas Imágenes")
- (slideshow-thaw-picts "Mostrar las Imágenes debajo del Puntero")
  (slideshow-hide-picts "Mostrar Cajas Anidadas")
  (slideshow-show-picts "Mostrar Imágenes")
  (slideshow-cannot-show-picts "No puedo mostrar imágenes; ejecuta el programa para capturar primero sus tamaños")