diff --git a/pkgs/drracket-pkgs/drracket/scribblings/drracket/extending.scrbl b/pkgs/drracket-pkgs/drracket/scribblings/drracket/extending.scrbl
index 6fbd48509f..88c5ca2773 100644
--- a/pkgs/drracket-pkgs/drracket/scribblings/drracket/extending.scrbl
+++ b/pkgs/drracket-pkgs/drracket/scribblings/drracket/extending.scrbl
@@ -102,6 +102,24 @@ the list @racket[all-nums] is bound to an infinite list
 For more examples, see the @filepath{htdp} sub-collection in the
 @filepath{teachpack} collection of the PLT installation.
 
+@subsection{Adding Your Own Teachpacks to the Teachpack Dialog}
+
+The @onscreen{Language|Add Teachpack...} dialog is extensible
+in two ways. First, users can add teachpacks to the third column
+by clicking the button at the bottom of the column. These additions
+are stored in the preferences file, so one way to add site-specific
+teachpacks is to provide a default preferences file.
+
+The first two columns are also extensible. When a collection has
+an @tech{info.rkt} file 
+(see also @secref[#:doc '(lib "scribblings/raco/raco.scrbl") "info.rkt"])
+that defines @racket[htdp-teachpacks] or @racket[2htdp-teachpacks],
+then they are expected to be either a list of (collection-relative)
+paths containing teachpacks to add to the dialog, or the symbol
+@racket['all], which means that all of the (top-level) files in the collection
+that end with @filepath{.rkt}, @filepath{.ss}, or @filepath{.scm}
+are teachpacks (except @filepath{info.rkt} or @filepath{info.ss}).
+
 @; ----------------------------------------------------------------------
 
 @section[#:tag "environment-variables"]{Environment Variables}
diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/htdp-langs.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/htdp-langs.rkt
index a147048c45..a5d1d80290 100644
--- a/pkgs/htdp-pkgs/htdp-lib/lang/htdp-langs.rkt
+++ b/pkgs/htdp-pkgs/htdp-lib/lang/htdp-langs.rkt
@@ -18,9 +18,11 @@
          mrlib/cache-image-snip
          (prefix-in ic: mrlib/image-core)
          setup/dirs
+         setup/getinfo
+         setup/collects
          test-engine/racket-tests
 
-         ;; this module is shared between the drscheme's namespace (so loaded here) 
+         ;; this module is shared between the drracket namespace (so loaded here) 
          ;; and the user's namespace in the teaching languages
          "private/set-result.rkt"
          "private/rewrite-error-message.rkt"
@@ -38,8 +40,7 @@
                   scheme-test-data error-handler test-format test-execute display-results
                   build-test-engine)
          (lib "test-engine/test-display.scm")
-         deinprogramm/signature/signature
-         )
+         deinprogramm/signature/signature)
   
   
   (provide tool@)
@@ -454,23 +455,23 @@
               (cond
                 [(= 1 (length tps))
                  (go ": " welcome)
-                 (go (cadr (car tps)) (drscheme:rep:get-dark-green-delta))]
+                 (go (tp-require->str (car tps)) (drscheme:rep:get-dark-green-delta))]
                 [(= 2 (length tps))
                  (go "s: " welcome)
-                 (go (cadr (car tps)) (drscheme:rep:get-dark-green-delta))
+                 (go (tp-require->str (car tps)) (drscheme:rep:get-dark-green-delta))
                  (go " and " welcome)
-                 (go (cadr (cadr tps)) (drscheme:rep:get-dark-green-delta))]
+                 (go (tp-require->str (cadr tps)) (drscheme:rep:get-dark-green-delta))]
                 [else
                  (go "s: " welcome)
-                 (go (cadr (car tps)) (drscheme:rep:get-dark-green-delta))
+                 (go (tp-require->str (car tps)) (drscheme:rep:get-dark-green-delta))
                  (let loop ([these-tps (cdr tps)])
                    (cond
                      [(null? (cdr these-tps))
                       (go ", and " welcome)
-                      (go (cadr (car these-tps)) (drscheme:rep:get-dark-green-delta))]
+                      (go (tp-require->str (car these-tps)) (drscheme:rep:get-dark-green-delta))]
                      [else
                       (go ", " welcome)
-                      (go (cadr (car these-tps)) (drscheme:rep:get-dark-green-delta))
+                      (go (tp-require->str (car these-tps)) (drscheme:rep:get-dark-green-delta))
                       (loop (cdr these-tps))]))])
               (go "." welcome)
               (newline port)))
@@ -479,6 +480,15 @@
             (for ([tp (in-list (htdp-lang-settings-teachpacks settings))])
               (namespace-require/constant tp)))
           
+          (define/private (tp-require->str tp)
+            (match tp
+              [`(lib ,x) 
+               (define m (regexp-match #rx"teachpack/2?htdp/(.*)$" x))
+               (if m
+                   (list-ref m 1)
+                   (format "~s" tp))]
+              [_ (format "~s" tp)]))
+          
           (inherit get-module get-transformer-module get-init-code
                    use-namespace-require/copy?)
           (define/override (create-executable setting parent program-filename)
@@ -597,7 +607,8 @@
           (define htdp-teachpack-callbacks
             (drscheme:unit:make-teachpack-callbacks
              (λ (settings) 
-               (map cadr (htdp-lang-settings-teachpacks settings)))
+               (map (λ (x) (tp-require->str x))
+                    (htdp-lang-settings-teachpacks settings)))
              (λ (settings parent) 
                (let ([teachpack (get-teachpack-from-user parent)])
                  (if teachpack
@@ -695,9 +706,24 @@
         (define tp-dirs (list "htdp" "2htdp"))
         (define labels (list (string-constant teachpack-pre-installed/htdp)
                              (string-constant teachpack-pre-installed/2htdp)))
-        (define tpss (map tp-dir->tps tp-dirs))
-        (define sort-order (λ (x y) (string<=? (path->string x) (path->string y))))
-        (define pre-installed-tpss (map (λ (tps) (sort tps sort-order)) tpss))
+        (define tp-syms '(htdp-teachpacks 2htdp-teachpacks))
+        (define tpss (map tp-dir->tps tp-syms))
+        
+        (define label+mpss
+          (for/list ([tps (in-list tpss)])
+            (let ([all-filenames (map (λ (tp) (list-ref tp 0)) tps)])
+              (for/list ([tp (in-list tps)])
+                (define filename (list-ref tp 0))
+                (define mp (list-ref tp 1))
+                (list (path->string 
+                       (or (shrink-path-wrt filename all-filenames)
+                           (let-values ([(base name dir?) (split-path filename)])
+                             name)))
+                      mp)))))
+        
+        (define pre-installed-tpss 
+          (for/list ([label+mps (in-list label+mpss)])
+            (sort label+mps string<? #:key car)))
         (define dlg (new (frame:focus-table-mixin dialog%) 
                          [parent parent]
                          [label (string-constant drscheme)]))
@@ -716,22 +742,29 @@
         
         (define pre-installed-lbs
           (map (λ (pre-installed-gb pre-installed-tps)
-                 (new list-box%
-                      [label #f]
-                      [choices (map path->string pre-installed-tps)]
-                      [stretchable-height #t]
-                      [min-height 300]
-                      [min-width 200]
-                      [callback
-                       (λ (this evt)
-                         (case (send evt get-event-type)
-                           [(list-box-dclick) (selected this)]
-                           [else
-                            (for-each (λ (x) (unless (eq? x this) (clear-selection x)))
-                                      (cons user-installed-lb
-                                            pre-installed-lbs))
-                            (update-button)]))]
-                      [parent pre-installed-gb]))
+                 (define lb 
+                   (new list-box%
+                        [label #f]
+                        [choices (map (λ (x) (gui-utils:trim-string (list-ref x 0) 200))
+                                      pre-installed-tps)]
+                        [stretchable-height #t]
+                        [min-height 300]
+                        [min-width 200]
+                        [callback
+                         (λ (this evt)
+                           (case (send evt get-event-type)
+                             [(list-box-dclick) (selected this)]
+                             [else
+                              (for ([x (in-list (cons user-installed-lb
+                                                      pre-installed-lbs))]
+                                    #:unless (eq? x this))
+                                (clear-selection x))
+                              (update-button)]))]
+                        [parent pre-installed-gb]))
+                 (for ([i (in-naturals)]
+                       [tp (in-list pre-installed-tps)])
+                   (send lb set-data i (list-ref tp 1)))
+                 lb)
                pre-installed-gbs
                pre-installed-tpss))
         
@@ -884,14 +917,12 @@
           (cond
             [(ormap (λ (pre-installed-lb tp-dir) 
                       (and (send pre-installed-lb get-selection)
-                           (list tp-dir (send pre-installed-lb get-string 
-                                              (send pre-installed-lb get-selection)))))
+                           (send pre-installed-lb get-data
+                                 (send pre-installed-lb get-selection))))
                     pre-installed-lbs
                     tp-dirs)
              =>
-             (λ (pr)
-               (define-values (tp-dir f) (apply values pr))
-               `(lib ,f "teachpack" ,tp-dir))]
+             values]
             [(send user-installed-lb get-selection)
              =>
              (λ (i) `(lib ,(send user-installed-lb get-string i)
@@ -905,12 +936,32 @@
         (send dlg show #t)
         answer)
       
-      (define (tp-dir->tps tp-dir)
-        (define known-tp (collection-file-path "image.rkt" "teachpack" tp-dir))
-        (define-values (base name dir?) (split-path known-tp))
+      (define (tp-dir->tps tp-sym)
         (filter
-         (λ (x) (file-exists? (build-path base x)))
-         (directory-list base)))
+         values
+         (for*/list ([dir (in-list (find-relevant-directories (list tp-sym)))]
+                     #:when (let ([inf (get-info/full dir)])
+                              (and inf (inf tp-sym (λ () #f))))
+                     [file-or-dir (in-list
+                                   (let ([files ((get-info/full dir) tp-sym)])
+                                     (cond
+                                       [(eq? files 'all)
+                                        (for/list ([x (in-list (directory-list dir))]
+                                                   #:when
+                                                   (regexp-match #rx"[.](ss|scm|rkt)$"
+                                                                 (path->string x))
+                                                   #:unless
+                                                   (member (path->string x) '("info.rkt" "info.ss")))
+                                          x)]
+                                       [(list? files) files]
+                                       [else '()])))])
+           (let/ec k
+             (unless (path? file-or-dir) (k #f))
+             (define candidate (build-path dir file-or-dir))
+             (unless (file-exists? candidate) (k #f))
+             (define mp (path->module-path candidate))
+             (when (path-string? mp) (k #f))
+             (list candidate mp)))))
 
       (define (stepper-settings-language %)
         (if (implementation? % stepper-language<%>)
@@ -1009,7 +1060,7 @@
       (define mf-note
         (let ([bitmap
                (make-object bitmap%
-                 (build-path (collection-path "icons") "mf.gif"))])
+                 (collection-file-path "mf.gif" "icons"))])
           (and (send bitmap ok?)
                (make-object image-snip% bitmap))))
       
diff --git a/pkgs/htdp-pkgs/htdp-lib/lang/run-teaching-program.rkt b/pkgs/htdp-pkgs/htdp-lib/lang/run-teaching-program.rkt
index b33176a7ef..ccb9f20f40 100644
--- a/pkgs/htdp-pkgs/htdp-lib/lang/run-teaching-program.rkt
+++ b/pkgs/htdp-pkgs/htdp-lib/lang/run-teaching-program.rkt
@@ -6,6 +6,7 @@
          scheme/class
          scheme/contract
          test-engine/racket-tests
+         syntax/modresolve
          (only-in racket/list split-at)
          (only-in racket/sequence sequence->list))
 
@@ -102,19 +103,15 @@
    values
    (for/list ([tp (in-list teachpacks)])
      (cond
-       [(file-exists? (build-path (apply collection-path (cddr tp))
-                                  (cadr tp)))
+       [(with-handlers ((exn:fail? (λ (x) #f)))
+          (file-exists? (resolve-module-path tp #f)))
         (stepper-skip
          (datum->syntax #f `(require ,tp)))]
        [else
         (eprintf "~a\n" (missing-tp-message tp))]))))
 
 (define (missing-tp-message x)
-  (let* ([m (regexp-match #rx"/([^/]*)$" (cadr x))]
-         [name (if m
-                   (cadr m)
-                   (cadr x))])
-    (format "the teachpack '~a' was not found" name)))
+  (format "the teachpack '~s' was not found" x))
 
 
 ;; rewrite-module : syntax -> syntax
diff --git a/pkgs/htdp-pkgs/htdp-lib/teachpack/2htdp/info.rkt b/pkgs/htdp-pkgs/htdp-lib/teachpack/2htdp/info.rkt
new file mode 100644
index 0000000000..6ab1a3d7d7
--- /dev/null
+++ b/pkgs/htdp-pkgs/htdp-lib/teachpack/2htdp/info.rkt
@@ -0,0 +1,4 @@
+#lang info
+
+(define 2htdp-teachpacks 'all)
+
diff --git a/pkgs/htdp-pkgs/htdp-lib/teachpack/htdp/info.rkt b/pkgs/htdp-pkgs/htdp-lib/teachpack/htdp/info.rkt
new file mode 100644
index 0000000000..7f2608ab88
--- /dev/null
+++ b/pkgs/htdp-pkgs/htdp-lib/teachpack/htdp/info.rkt
@@ -0,0 +1,5 @@
+#lang info
+
+(define htdp-teachpacks 'all)
+
+