From 92b7304f8947a0fa37a6326c3e9705ddae317858 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 13 Jul 2013 10:04:40 +0900 Subject: [PATCH] Using standard @ instead of ^ as the SXML attributes symbols. This was never a portable aspect of SXML before because in earlier standards @ was an illegal identifier, but it is allowed in R7RS. Scribble requires escaping with @|@| to pass through a raw @ symbol. Considering using \ as the default scribble escape instead. --- lib/chibi/config.scm | 4 ++-- lib/chibi/doc.scm | 28 ++++++++++++++-------------- lib/chibi/highlight.scm | 2 +- lib/chibi/mime.scm | 8 ++++---- lib/chibi/sxml.scm | 8 ++++---- tests/match-tests.scm | 12 ++++++------ 6 files changed, 31 insertions(+), 31 deletions(-) diff --git a/lib/chibi/config.scm b/lib/chibi/config.scm index 922e813e..f9b75a5b 100644 --- a/lib/chibi/config.scm +++ b/lib/chibi/config.scm @@ -19,7 +19,7 @@ ;;> command-line options, config files, environment variables, and/or ;;> other specialized settings. These all have various pros and cons: ;;> -;;> @table[(^ (border 1) (style border-collapse:collapse) (width "100%"))]{ +;;> @table[(@|@| (border 1) (style border-collapse:collapse) (width "100%"))]{ ;;> @tr{@th{name} @th{pros} @th{cons}} ;;> @tr{@td{environment variables} ;;> @td{implicit - no need to retype; can share between applications} @@ -55,7 +55,7 @@ ;;> coercing to a list. The result is determined according to the ;;> structure of the alist cell as follows: ;;> -;;> @table[(^ (border 1) (style border-collapse:collapse) (width "100%"))]{ +;;> @table[(@|@| (border 1) (style border-collapse:collapse) (width "100%"))]{ ;;> @tr{@th{Cell} @th{@scheme{conf-get} result} @th{@scheme{conf-get-list} result}} ;;> @tr{@td{@scheme{(key)}} @td{@scheme{()}} @td{@scheme{()}}} ;;> @tr{@td{@scheme{(key . non-list-value)}} @td{@scheme{non-list-value}} @td{@scheme{(non-list-value)}}} diff --git a/lib/chibi/doc.scm b/lib/chibi/doc.scm index 04f16d67..78c00f66 100644 --- a/lib/chibi/doc.scm +++ b/lib/chibi/doc.scm @@ -84,7 +84,7 @@ (define (sxml-body x) (cond ((not (and (pair? x) (pair? (cdr x)))) '()) - ((and (pair? (cadr x)) (eq? '^ (car (cadr x)))) (cddr x)) + ((and (pair? (cadr x)) (eq? '@ (car (cadr x)))) (cddr x)) (else (cdr x)))) (define (env-ref env name . o) @@ -168,27 +168,27 @@ (body (map (lambda (x) (expand-docs x env)) (if name (cdr (cddr sxml)) (cdr sxml)))) (name (or name (sxml-strip (cons tag body))))) - `(div (a (^ (name . ,(section-name tag name)))) (,tag ,@body)))))) + `(div (a (@ (name . ,(section-name tag name)))) (,tag ,@body)))))) (define (expand-url sxml env) (if (not (= 2 (length sxml))) (error "url expects one argument" sxml) (let ((url (expand-docs (cadr sxml) env))) - `(a (^ (href . ,url)) ,url)))) + `(a (@ (href . ,url)) ,url)))) (define (expand-hyperlink sxml env) (if (not (>= (length sxml) 3)) (error "hyperlink expects at least two arguments" sxml) (let ((url (expand-docs (cadr sxml) env))) - `(a (^ (href . ,url)) + `(a (@ (href . ,url)) ,(map (lambda (x) (expand-docs x env)) (cddr sxml)))))) (define (expand-note sxml env) - `(div (^ (id . "notes")) + `(div (@ (id . "notes")) ,@(map (lambda (x) (expand-docs x env)) (cdr sxml)))) (define (expand-author sxml env) - `(div (^ (id . "notes")) + `(div (@ (id . "notes")) ,@(map (lambda (x) (expand-docs x env)) (cdr sxml)) (br) ,(seconds->string (current-seconds)))) @@ -213,7 +213,7 @@ `(div ,(expand-codeblock `(,(car x) language: scheme ,@(cdr x)) env) (code - (div (^ (class . "result")) + (div (@ (class . "result")) ,(call-with-output-string (lambda (out) (protect (exn (#t (print-exception exn out))) @@ -227,7 +227,7 @@ "") (define (expand-command sxml env) - `(pre (^ (class . "command")) + `(pre (@ (class . "command")) (code ,@(map (lambda (x) (expand-docs x env)) (cdr sxml))))) (define (expand-tagged tag ls env) @@ -260,10 +260,10 @@ (define (extract-contents x) (match x - (('div ('a ('^ ('name . name)) . _) + (('div ('a ('@ ('name . name)) . _) ((and h (or 'h1 'h2 'h3 'h4 'h5 'h6)) . section)) `((,(header-index h) - (a (^ (href . ,(string-append "#" name))) + (a (@ (href . ,(string-append "#" name))) ,(sxml-strip (cons h section)))))) ((a . b) (append (extract-contents a) (extract-contents b))) @@ -289,7 +289,7 @@ `(html (head ,@(cond ((assq 'title x) => (lambda (x) (list x))) (else '())) "\n" - (style (^ (type . "text/css")) + (style (@ (type . "text/css")) " body {color: #000; background-color: #FFF} div#menu {font-size: smaller; position: absolute; top: 50px; left: 0; width: 180px; height: 100%} @@ -302,15 +302,15 @@ div#footer {padding-bottom: 50px} ,(highlight-style)) "\n") (body - (div (^ (id . "menu")) + (div (@ (id . "menu")) ,(get-contents (extract-contents x))) - (div (^ (id . "main")) + (div (@ (id . "main")) ,@(map (lambda (x) (if (and (pair? x) (eq? 'title (car x))) (cons 'h1 (cdr x)) x)) x) - (div (^ (id . "footer"))))))) + (div (@ (id . "footer"))))))) (define (fix-paragraphs x) (let lp ((ls x) (p '()) (res '())) diff --git a/lib/chibi/highlight.scm b/lib/chibi/highlight.scm index 2f872df1..6d43f7f2 100644 --- a/lib/chibi/highlight.scm +++ b/lib/chibi/highlight.scm @@ -98,7 +98,7 @@ (cdr (iota (+ 1 (length highlight-paren-styles)))))))) (define (highlight-class class x) - `(span (^ (class . ,class)) ,@(if (list? x) x (list x)))) + `(span (@ (class . ,class)) ,@(if (list? x) x (list x)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lib/chibi/mime.scm b/lib/chibi/mime.scm index 72a289d9..c2d9b758 100644 --- a/lib/chibi/mime.scm +++ b/lib/chibi/mime.scm @@ -268,7 +268,7 @@ (if (and (pair? o) (pair? (cdr o))) (car (cdr o)) (lambda (headers parent-seed seed) - `((mime (^ ,@headers) + `((mime (@ ,@headers) ,@(if (pair? seed) (reverse seed) seed)) ,@parent-seed)))) (headers @@ -319,7 +319,7 @@ ;;> ;;> Parse the given source as a MIME message and return ;;> the result as an SXML object of the form: -;;> @scheme{(mime (^ (header . value) ...) parts ...)}. +;;> @scheme{(mime (@ (header . value) ...) parts ...)}. (define (mime-message->sxml . o) (car @@ -327,11 +327,11 @@ mime-message-fold (if (pair? o) (car o) (current-input-port)) (lambda (parent-headers headers body seed) - `((mime (^ ,@headers) ,body) ,@seed)) + `((mime (@ ,@headers) ,body) ,@seed)) '() (lambda (headers seed) '()) (lambda (headers parent-seed seed) - `((mime (^ ,@headers) + `((mime (@ ,@headers) ,@(if (pair? seed) (reverse seed) seed)) ,@parent-seed)) (if (pair? o) (cdr o) '())))) diff --git a/lib/chibi/sxml.scm b/lib/chibi/sxml.scm index 6dc49cf9..469310af 100644 --- a/lib/chibi/sxml.scm +++ b/lib/chibi/sxml.scm @@ -89,7 +89,7 @@ (cond ((and (pair? rest) (pair? (car rest)) - (eq? '^ (caar rest))) + (eq? '@ (caar rest))) (display (html-tag->string tag (cdar rest)) out) (for-each lp (cdr rest)) (display "" out)) @@ -110,7 +110,7 @@ ((pair? x) (for-each strip - (if (and (pair? (cdr x)) (eq? '^ (cadr x))) (cddr x) (cdr x)))) + (if (and (pair? (cdr x)) (eq? '@ (cadr x))) (cddr x) (cdr x)))) ((string? x) (display x out))))))) @@ -127,13 +127,13 @@ (and (eq? 'div tag) (pair? (cdr sxml)) (pair? (cadr sxml)) - (eq? '^ (car (cadr sxml))) + (eq? '@ (car (cadr sxml))) (equal? '(id . "menu") (assq 'id (cdr (cadr sxml))))))) ;; recurse other tags, appending newlines for new sections ((symbol? tag) (for-each lp - (if (and (pair? (cdr sxml)) (eq? '^ (cadr sxml))) + (if (and (pair? (cdr sxml)) (eq? '@ (cadr sxml))) (cddr sxml) (cdr sxml))) (if (memq tag '(p br h1 h2 h3 h4 h5 h6)) diff --git a/tests/match-tests.scm b/tests/match-tests.scm index e1e106e3..a9500e19 100644 --- a/tests/match-tests.scm +++ b/tests/match-tests.scm @@ -122,21 +122,21 @@ (else #f))) (test "sxml tree search" '(((href . "http://synthcode.com/")) ("synthcode")) - (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f))) - (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...)) + (match '(p (ul (li a (b c) (a (@ (href . "http://synthcode.com/")) "synthcode") d e f))) + (((or 'p 'ul 'li 'b) *** ('a ('@ attrs ...) text ...)) (list attrs text)) (else #f))) (test "failed sxml tree search" #f - (match '(p (ol (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f))) - (((or 'p 'ul 'li 'b) *** ('a ('^ attrs ...) text ...)) + (match '(p (ol (li a (b c) (a (@ (href . "http://synthcode.com/")) "synthcode") d e f))) + (((or 'p 'ul 'li 'b) *** ('a ('@ attrs ...) text ...)) (list attrs text)) (else #f))) (test "collect tree search" '((p ul li) ((href . "http://synthcode.com/")) ("synthcode")) - (match '(p (ul (li a (b c) (a (^ (href . "http://synthcode.com/")) "synthcode") d e f))) - (((and tag (or 'p 'ul 'li 'b)) *** ('a ('^ attrs ...) text ...)) + (match '(p (ul (li a (b c) (a (@ (href . "http://synthcode.com/")) "synthcode") d e f))) + (((and tag (or 'p 'ul 'li 'b)) *** ('a ('@ attrs ...) text ...)) (list tag attrs text)) (else #f)))