add and use at-exp meta-language

svn: r13731

collects/at-exp/lang/reader.ss

@@ -0,0 +1,61 @@
+#lang scheme/base
+
+(require syntax/readerr
+         (only-in scribble/reader make-at-readtable))
+
+(provide (rename-out [at-read read]
+                     [at-read-syntax read-syntax])
+         get-info)
+
+(define (at-get in export-sym src line col pos mk-fail-thunk)
+  (let ([spec (regexp-try-match #px"^[ \t]+(.*?)(\\s|$)" in)]
+        [bad (lambda (str eof?)
+               ((if eof?
+                    raise-read-eof-error 
+                    raise-read-error)
+                (format "bad language path following at-exp~a~a"
+                        (if str ": " "")
+                        (or str ""))
+                src line col pos
+                (let-values ([(line col pos2) (port-next-location in)])
+                  (and pos pos2 (- pos2 pos)))))])
+    (if (or (not spec)
+            (equal? (cadr spec) ""))
+        (bad #f (eof-object? (peek-byte in)))
+        (let ([parsed-spec
+               (let ([s (string->symbol 
+                         (string-append (bytes->string/latin-1 (cadr spec))
+                                        "/lang/reader"))])
+                 (if (module-path? s)
+                     s
+                     #f))])
+          (if parsed-spec
+              (begin
+                ((current-reader-guard) parsed-spec)
+                (dynamic-require parsed-spec export-sym (mk-fail-thunk spec)))
+              (bad (cadr spec) #f))))))
+
+(define (get-info in mod line col pos)
+  (at-get in 'get-info (object-name in) line col pos
+              (lambda (spec) (lambda () (lambda (tag) #f)))))
+
+(define at-readtable (make-at-readtable))
+
+(define (at-read-fn in read-sym args src mod line col pos)
+  (let ([r (at-get in read-sym src #|mod|# line col pos
+                   (lambda (spec) 
+                     (lambda ()
+                       (error 'at "cannot find reader for `#lang at ~a'" spec))))])
+    (parameterize ([current-readtable at-readtable])
+      (if (and (procedure? r)
+               (procedure-arity-includes? r (+ 5 (length args))))
+          (apply r (append args
+                           (list in mod line col pos)))
+          (apply r (append args (list in)))))))
+
+(define (at-read inp mod line col pos)
+  (at-read-fn inp 'read null (object-name inp) mod line col pos))
+
+(define (at-read-syntax src inp mod line col pos)
+  (at-read-fn inp 'read-syntax (list src) src mod line col pos))
+

collects/file/gif.ss

@@ -14,8 +14,8 @@
  *****************************************************************************/
 |#
 
-#reader scribble/reader
-#lang scheme/base
+#lang at-exp scheme/base
+
 (require scheme/contract
          scribble/srcdoc
          (prefix-in octree: file/private/octree-quantize))

collects/framework/main.ss

@@ -1,5 +1,4 @@
-#reader scribble/reader
-#lang scheme/gui
+#lang at-exp scheme/gui
 
 (require mred/mred-unit
          mred/mred-sig

collects/scribblings/scribble/reader.scrbl

@@ -23,13 +23,16 @@ You can use the reader via MzScheme's @schemefont{#reader} form:
       #reader scribble/reader @foo{This is free-form text!}
 }|]
 
+or use the @scheme[at-exp] meta-language as described in
+@secref["at-exp-lang"].
+
 Note that the Scribble reader reads @"@"-forms as S-expressions.  This
 means that it is up to you to give meanings for these expressions in
 the usual way: use Scheme functions, define your functions, or require
 functions.  For example, typing the above into MzScheme is likely
-going to produce a ``reference to undefined identifier'' error --- you
-can use @scheme[string-append] instead, or you can define @scheme[foo]
-as a function (with variable arity).
+going to produce a ``reference to undefined identifier'' error, unless
+@scheme[foo] is defined. You can use @scheme[string-append] instead,
+or you can define @scheme[foo] as a function (with variable arity).
 
 A common use of the Scribble @"@"-reader is when using Scribble as a
 documentation system for producing manuals.  In this case, the manual
@@ -37,7 +40,7 @@ text is likely to start with
 
 @schememod[scribble/doc]
 
-which installs the @"@" reader starting in ``text mode'', wraps the
+which installs the @"@" reader starting in ``text mode,'' wraps the
 file content afterward into a MzScheme module where many useful Scheme
 and documentation related functions are available, and parses the body
 into a document using @schememodname[scribble/decode].  See
@@ -833,6 +836,25 @@ is an example of this.
    })
 ]
 
+@;--------------------------------------------------------------------
+@section[#:tag "at-exp-lang"]{Adding @"@"-expressions to a Language}
+
+@defmodulelang[at-exp]{The @schememodname[at-exp] language installs
+@"@"-reader support in the readtable, and then chains to the reader of
+another language that is specified immediate after
+@schememodname[at-exp].}
+
+For example, @scheme[#, @hash-lang[] at-exp scheme/base] adds @"@"-reader
+support to @scheme[scheme/base], so that
+
+@schememod[
+at-exp scheme/base
+
+(define (greet who) #, @elem{@tt["@"]@scheme[string-append]@schemeparenfont["{"]@schemevalfont{Hello, }@tt["@|"]@scheme[who]@tt["|"]@schemevalfont{.}@schemeparenfont["}"]})
+(greet "friend")]
+
+reports @scheme["Hello, friend."].
+
 @;--------------------------------------------------------------------
 @section{Interface}