From 81c244f607757625543a82fa996fde88d7cb0e68 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 10 Jul 2007 07:08:16 +0000
Subject: [PATCH] doc work: reference on syntax objects

svn: r6882

original commit: 8470b614669a3c57f11f329e07c86459ab588e45
---
 collects/scribble/manual.ss | 21 +++++++++++++++++++--
 collects/scribble/scheme.ss |  1 +
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index 998ca244..287d86d4 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -192,6 +192,7 @@
 
   (provide defproc defproc* defstruct defthing defparam defboolparam
            defform defform* defform/subs defform*/subs defform/none
+           defidform
            specform specform/subs 
            specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline
            schemegrammar schemegrammar*
@@ -311,6 +312,15 @@
                     '(spec) (list (lambda (ignored) (schemeblock0 spec))) 
                     null null
                     (lambda () (list desc ...)))]))
+  (define-syntax (defidform stx)
+    (syntax-case stx ()
+      [(_ spec-id desc ...)
+       #'(*defforms (quote-syntax spec-id) null
+                    '(spec-id)
+                    (list (lambda (x) (make-paragraph (list x))))
+                    null
+                    null
+                    (lambda () (list desc ...)))]))
   (define-syntax specsubform
     (syntax-rules ()
       [(_ #:literals (lit ...) spec desc ...)
@@ -837,7 +847,11 @@
                     (apply 
                      append
                      (map (lambda (form)
-                            (let loop ([form (cons (if kw-id (cdr form) form)
+                            (let loop ([form (cons (if kw-id 
+                                                       (if (pair? form)
+                                                           (cdr form) 
+                                                           null)
+                                                       form)
                                                    subs)])
                               (cond
                                [(symbol? form) (if (or (meta-symbol? form)
@@ -869,7 +883,10 @@
                           (eq? form (car forms))
                           (make-target-element
                            #f
-                           (list (to-element (make-just-context (car form) kw-id)))
+                           (list (to-element (make-just-context (if (pair? form)
+                                                                    (car form) 
+                                                                    form)
+                                                                kw-id)))
                            (register-scheme-form-definition kw-id))))))))
                forms form-procs)
           (if (null? sub-procs)
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
index 74622b0a..78e27449 100644
--- a/collects/scribble/scheme.ss
+++ b/collects/scribble/scheme.ss
@@ -363,6 +363,7 @@
                           (let ([c (syntax-e c)])
                             (let ([s (format "~s" c)])
                               (if (and (symbol? c)
+                                       ((string-length s) . > . 1)
                                        (char=? (string-ref s 0) #\_))
                                   (values (substring s 1) #t #f)
                                   (values s #f #f))))]