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))))]