schemeorg-community
/
registry.scheme.org
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add superscripts

This commit is contained in:
Lassi Kortela 2021-01-24 13:56:41 +02:00
parent 2c68445991
commit 8a608872a5
1 changed files with 34 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
generate.scm
View File

@ -42,6 +42,20 @@
(let ((x (assoc key alist))) (let ((x (assoc key alist)))
(if (and (list? x) (= 2 (length x))) (cadr x) (error "Nope")))) (if (and (list? x) (= 2 (length x))) (cadr x) (error "Nope"))))
(define (superscripts s)
(let ((n (string-length s)))
(let loop ((a 0) (b 0) (acc '()))
(cond ((= n b a)
(reverse acc))
((= n b)
(loop b b (cons (substring s a b) acc)))
((char=? #\^ (string-ref s b))
(loop (+ b 2) (+ b 2)
(append `((sup ,(string (string-ref s (+ b 1))))
,(substring s a b))
acc)))
(else (loop a (+ b 1) acc))))))
(define (display-sxml x) (define (display-sxml x)
(define (display* . xs) (for-each display xs)) (define (display* . xs) (for-each display xs))
(define (display-char char) (define (display-char char)
@ -80,6 +94,9 @@
(list-sort (lambda (a b) (string<? (assoc1 'id a) (assoc1 'id b))) (list-sort (lambda (a b) (string<? (assoc1 'id a) (assoc1 'id b)))
entries)) entries))
(define (format-description entry)
(superscripts (assoc1 'description entry)))
(define (classify class entries) (define (classify class entries)
(map (lambda (entry) `((class ,class) ,@entry)) (map (lambda (entry) `((class ,class) ,@entry))
entries)) entries))
@ -94,7 +111,7 @@
,(string-append ,(string-append
"p-" "p-"
(string-downcase heading)))) (string-downcase heading))))
,column)) ,@column))
(cdr row) (cdr row)
column-headings))) column-headings)))
`(tr (@ (class ,(if class `(tr (@ (class ,(if class
@ -105,8 +122,8 @@
(define (the-usual entry) (define (the-usual entry)
(cons (assoc? 'class entry) (cons (assoc? 'class entry)
`((code ,(symbol->string (assoc1 'id entry))) `(((code ,(symbol->string (assoc1 'id entry))))
,(assoc1 'description entry)))) ,(format-description entry))))
(define (registry registry-title registry-id intro table) (define (registry registry-title registry-id intro table)
`(section `(section
@ -133,7 +150,7 @@
(map (lambda (entry) (map (lambda (entry)
(let ((year (assoc? 'year entry))) (let ((year (assoc? 'year entry)))
(append (the-usual entry) (append (the-usual entry)
(list (if year (number->string year) ""))))) (list (list (if year (number->string year) ""))))))
(group-file 'id "scheme-standard.scm"))))) (group-file 'id "scheme-standard.scm")))))
(define (scheme-id) (define (scheme-id)
@ -145,7 +162,7 @@
(tabulate (tabulate
'("ID" "Name" "Contact") '("ID" "Name" "Contact")
(map (lambda (entry) (map (lambda (entry)
(append (the-usual entry) (list (assoc1 'contact entry)))) (append (the-usual entry) (list (list (assoc1 'contact entry)))))
(sort-by-id (group-file 'id "scheme-id.scm")))))) (sort-by-id (group-file 'id "scheme-id.scm"))))))
(define (operating-system) (define (operating-system)
@ -216,9 +233,9 @@
'("ID" "Escape" "Description") '("ID" "Escape" "Description")
(map (lambda (entry) (map (lambda (entry)
(cons (assoc? 'class entry) (cons (assoc? 'class entry)
`((code ,(symbol->string (assoc1 'id entry))) `(((code ,(symbol->string (assoc1 'id entry))))
(code ,(or (assoc? 'string-escape entry) "")) ((code ,(or (assoc? 'string-escape entry) "")))
,(assoc1 'description entry)))) ,(format-description entry))))
(sort-by-id (group-file 'id "character-name.scm")))))) (sort-by-id (group-file 'id "character-name.scm"))))))
(define (hash-syntax) (define (hash-syntax)
@ -230,8 +247,8 @@
'("ID" "Description") '("ID" "Description")
(map (lambda (entry) (map (lambda (entry)
(cons (assoc? 'class entry) (cons (assoc? 'class entry)
`((code ,(assoc1 'id entry)) `(((code ,(assoc1 'id entry)))
,(assoc1 'description entry)))) ,(format-description entry))))
(sort-by-string-id (group-file 'id "hash-syntax.scm")))))) (sort-by-string-id (group-file 'id "hash-syntax.scm"))))))
(define (hash-bang-syntax) (define (hash-bang-syntax)
@ -243,9 +260,9 @@
'("ID" "Role" "Description") '("ID" "Role" "Description")
(map (lambda (entry) (map (lambda (entry)
(cons (assoc? 'class entry) (cons (assoc? 'class entry)
`((code ,(symbol->string (assoc1 'id entry))) `(((code ,(symbol->string (assoc1 'id entry))))
,(symbol->string (assoc1 'role entry)) (,(symbol->string (assoc1 'role entry)))
,(assoc1 'description entry)))) ,(format-description entry))))
(sort-by-id (group-file 'id "hash-bang-syntax.scm")))))) (sort-by-id (group-file 'id "hash-bang-syntax.scm"))))))
(define (filename-extension) (define (filename-extension)
@ -257,9 +274,9 @@
'("Extension" "Stands for" "Description") '("Extension" "Stands for" "Description")
(map (lambda (entry) (map (lambda (entry)
(cons (assoc? 'class entry) (cons (assoc? 'class entry)
`((code ,(assoc1 'id entry)) `(((code ,(assoc1 'id entry)))
,(assoc1 'stands-for entry) (,(assoc1 'stands-for entry))
,(assoc1 'description entry)))) ,(format-description entry))))
(group-file 'id "filename-extension.scm"))))) (group-file 'id "filename-extension.scm")))))
(define (version-flag-property) (define (version-flag-property)
@ -270,7 +287,7 @@
(tabulate (tabulate
'("ID" "Description" "Type") '("ID" "Description" "Type")
(map (lambda (entry) (map (lambda (entry)
(append (the-usual entry) (list (assoc1 'type entry)))) (append (the-usual entry) (list (list (assoc1 'type entry)))))
(sort-by-id (group-file 'id "version-flag-property.scm")))))) (sort-by-id (group-file 'id "version-flag-property.scm"))))))
(define (display-page) (define (display-page)