From b300bae75c31c7efdd82a8a32665f29290c2a02f Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 13 Aug 2011 14:46:14 -0500
Subject: [PATCH] added the lang/htdp-langs-save-file-prefix library   to help
 detect HtDP-lang save files

---
 collects/lang/htdp-langs-save-file-prefix.rkt | 36 +++++++++++++++++++
 collects/lang/htdp-langs.rkt                  | 11 ++++--
 collects/scribblings/tools/tools.scrbl        | 20 +++++++++++
 3 files changed, 64 insertions(+), 3 deletions(-)
 create mode 100644 collects/lang/htdp-langs-save-file-prefix.rkt

diff --git a/collects/lang/htdp-langs-save-file-prefix.rkt b/collects/lang/htdp-langs-save-file-prefix.rkt
new file mode 100644
index 0000000000..d4f404ae48
--- /dev/null
+++ b/collects/lang/htdp-langs-save-file-prefix.rkt
@@ -0,0 +1,36 @@
+#lang racket/base
+(require racket/contract
+         racket/port)
+
+(provide/contract
+ [htdp-save-file-prefix (listof string?)]
+ [htdp-file-prefix? (-> input-port? boolean?)])
+
+(define htdp-save-file-prefix
+  (list ";; The first three lines of this file were inserted by DrRacket. They record metadata"
+        ";; about the language level of this file in a form that our tools can easily process."))
+
+(define (htdp-file-prefix? port)
+  (define pp (peeking-input-port port))
+  (define ans (htdp-file-prefix/raw? pp))
+  (when ans
+    (htdp-file-prefix/raw? port))
+  ans)
+  
+;; htdp-file-prefix/raw? : input-port? -> boolean
+;; SIDE EFFECT: consumes input from the port;
+;;  in the case the it returns #t, then it consumes precisely
+;;  the prefix that DrRacket saves
+;;  in the case that it returns #f, it consumes some random amount
+(define (htdp-file-prefix/raw? port)
+  (let loop ([prefix htdp-save-file-prefix])
+    (cond
+      [(null? prefix)
+       (define l (read-line port 'any))
+       (and (string? l)
+            (regexp-match #rx"^#reader" l))]
+      [else
+       (define l (read-line port 'any))
+       (and (string? l)
+            (equal? l (car prefix))
+            (loop (cdr prefix)))])))
diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt
index b1ab27637b..bf1973e3fe 100644
--- a/collects/lang/htdp-langs.rkt
+++ b/collects/lang/htdp-langs.rkt
@@ -31,6 +31,8 @@
          "stepper-language-interface.rkt"
          "debugger-language-interface.rkt"
          "run-teaching-program.rkt"
+         "htdp-langs-save-file-prefix.rkt"
+         
          stepper/private/shared
 
          (only-in test-engine/scheme-gui make-formatter)
@@ -633,8 +635,9 @@
           (define/override (get-reader-module) reader-module)
           (define/override (get-metadata modname settings)
             (string-append
-             ";; The first three lines of this file were inserted by DrRacket. They record metadata\n"
-             ";; about the language level of this file in a form that our tools can easily process.\n"
+             (apply string-append
+                    (map (λ (x) (string-append x "\n"))
+                         htdp-save-file-prefix))
              (format "#reader~s~s\n"
                      reader-module
                      `((modname ,modname)
@@ -1005,7 +1008,9 @@
                        [(exn:srclocs? exn) 
                         ((exn:srclocs-accessor exn) exn)]
                        [(exn? exn) 
-                        (let ([cms (continuation-mark-set->list (exn-continuation-marks exn) teaching-languages-continuation-mark-key)])
+                        (let ([cms (continuation-mark-set->list 
+                                    (exn-continuation-marks exn)
+                                    teaching-languages-continuation-mark-key)])
 			  (cond
 			   ((not cms) '())
 			   ((findf (lambda (mark)
diff --git a/collects/scribblings/tools/tools.scrbl b/collects/scribblings/tools/tools.scrbl
index b0da4ff0c1..c1ce0856e2 100644
--- a/collects/scribblings/tools/tools.scrbl
+++ b/collects/scribblings/tools/tools.scrbl
@@ -804,6 +804,26 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
   The bitmap in the Check Syntax button on the DrRacket frame.
 }
 
+@section{Teaching Languages}
+
+The teaching language are implemented via the tools interface and thus
+not part of DrRacket proper, but one helper library is documented here.
+
+@defmodule[lang/htdp-langs-save-file-prefix]
+
+@defthing[htdp-save-file-prefix (listof string?)]{
+  These strings are used as the prefix in a file saved while using the teaching
+  languages. Each string is on a separate line in the saved file.
+}
+@defproc[(htdp-file-prefix? [ip input-port?]) boolean?]{
+  Determines if the contents of @racket[ip] is one of the possible prefixes that
+  DrRacket saves at the beginning of a teaching language file.
+  
+  In the case that this function returns @racket[#t], it consumes the entire prefix
+  from @racket[ip] (and discards it). In the case that this function returns
+  @racket[#f], it does not consume anything from @racket[ip].
+}
+
 @include-section["get-slash-extend.scrbl"]
 @include-section["unit.scrbl"]
 @include-section["language.scrbl"]