Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Automated Resyntax fixes #461

Open
wants to merge 9 commits into
base: master
Choose a base branch
from
3 changes: 2 additions & 1 deletion scribble-html-lib/scribble/html/html.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,8 @@
;; https://html.spec.whatwg.org/multipage/#toc-semantics
;; Put esoteric elements in scribble/html/extra

(require "xml.rkt" scribble/text)
(require scribble/text
"xml.rkt")

;; ----------------------------------------------------------------------------
;; Doctype line
Expand Down
5 changes: 3 additions & 2 deletions scribble-html-lib/scribble/html/lang.rkt
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
#lang racket/base

(require "main.rkt" (except-in scribble/text/lang #%top)
scribble/text/syntax-utils)
(require scribble/text/syntax-utils
(except-in scribble/text/lang #%top)
"main.rkt")

(provide (except-out (all-from-out scribble/text/lang) #%module-begin)
(rename-out [module-begin #%module-begin])
Expand Down
91 changes: 47 additions & 44 deletions scribble-html-lib/scribble/html/resource.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -57,11 +57,10 @@
(set! cached-roots
(cons roots
(and (list? roots) (pair? roots)
(map (lambda (root)
(list* (regexp-match* #rx"[^/]+" (car root))
(regexp-replace #rx"/$" (cadr root) "")
(cddr root)))
roots)))))
(for/list ([root (in-list roots)])
(list* (regexp-match* #rx"[^/]+" (car root))
(regexp-replace #rx"/$" (cadr root) "")
(cddr root)))))))
(cdr cached-roots))

;; a utility for relative paths, taking the above `default-file' and
Expand All @@ -70,22 +69,23 @@
(define file* (if (equal? file default-file) "" file))
(define roots (current-url-roots))
(define (find-root path mode)
(ormap (lambda (root+url+flags)
(let loop ([r (car root+url+flags)] [p path])
(if (pair? r)
(and (pair? p) (equal? (car p) (car r))
(loop (cdr r) (cdr p)))
(case mode
[(get-path) `(,(cadr root+url+flags)
,@p
,(if (and (equal? file* "")
(memq 'index (cddr root+url+flags)))
default-file
file*))]
[(get-abs-or-true)
(if (memq 'abs (cddr root+url+flags)) `("" ,@p) #t)]
[else (error 'relativize "internal error: ~e" mode)]))))
roots))
(for/or ([root+url+flags (in-list roots)])
(let loop ([r (car root+url+flags)]
[p path])
(if (pair? r)
(and (pair? p) (equal? (car p) (car r)) (loop (cdr r) (cdr p)))
(case mode
[(get-path)
`(,(cadr root+url+flags) ,@p
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@jackfirth I'd rather see

(append (list (cadr root+url+flags)) 
        p 
        (list (if ...)))

here.

In general, I think quasiquote should only be preserved if there exists an item that is not unquote / unquote-splicing. If all of them are unquote / unquote-splicing, either it should be converted to a list or an append.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'd use a different rule for this. If I'm thinking of it as an sexpression, I'd use quasiquote and friends; if I'm thinking of it as a list, I'd use append and friends.

So maybe the quasiquote should be preserved by the tool and a user should make this judgment?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it's pretty fuzzy in a lot of cases, so Resyntax is conservative and only takes a hard stance on the cases that seem clearly absurd to me like this:

`(,a ,b ,c)
; just write `(list ...)` man, you're not fooling anyone

In the code you commented on, I would also prefer to avoid quotation for the same reason as you. But I dislike datum quotations generally and that's a much stronger stance than many Racketeers. So I don't think Resyntax should actively discourage it.

,(if (and (equal? file* "")
(memq 'index (cddr root+url+flags)))
default-file
file*))]
[(get-abs-or-true)
(if (memq 'abs (cddr root+url+flags))
`("" ,@p)
#t)]
[else (error 'relativize "internal error: ~e" mode)])))))
(define result
(let loop ([t tgtdir] [c curdir] [pfx '()])
(cond
Expand Down Expand Up @@ -165,9 +165,11 @@
(define t (make-hash))
(define-syntax-rule (S body) (call-with-semaphore s (lambda () body)))
(values (lambda (path renderer)
(S (if (hash-ref t path #f)
(error 'resource "path used for two resources: ~e" path)
(begin (hash-set! t path #t) (set! l (cons renderer l))))))
(S (cond
[(hash-ref t path #f) (error 'resource "path used for two resources: ~e" path)]
[else
(hash-set! t path #t)
(set! l (cons renderer l))])))
(lambda () (S (begin0 (reverse l) (set! l '())))))))

;; `#:exists' determines what happens when the render destination exists, it
Expand All @@ -180,32 +182,33 @@
(define (resource path0 renderer #:exists [exists 'delete-file])
(define (bad reason) (error 'resource "bad path, ~a: ~e" reason path0))
(unless (string? path0) (bad "must be a string"))
(for ([x (in-list '([#rx"^/" "must be relative"]
[#rx"//" "must not have empty elements"]
[#rx"(?:^|/)[.][.]?(?:/|$)"
"must not contain `.' or `..'"]))])
(when (regexp-match? (car x) path0) (bad (cadr x))))
(for ([x (in-list '([#rx"^/" "must be relative"] [#rx"//" "must not have empty elements"]
[#rx"(?:^|/)[.][.]?(?:/|$)"
"must not contain `.' or `..'"]))]
#:when (regexp-match? (car x) path0))
(bad (cadr x)))
(define path (regexp-replace #rx"(?<=^|/)$" path0 default-file))
(define-values [dirpathlist filename]
(let-values ([(l r) (split-at-right (regexp-split #rx"/" path) 1)])
(values l (car r))))
(define (render)
(let loop ([ps dirpathlist])
(if (pair? ps)
(begin (unless (directory-exists? (car ps))
(if (or (file-exists? (car ps)) (link-exists? (car ps)))
(bad "exists as a file/link")
(make-directory (car ps))))
(parameterize ([current-directory (car ps)])
(loop (cdr ps))))
(begin (cond [(not exists)] ; do nothing
[(or (file-exists? filename) (link-exists? filename))
(delete-file filename)]
[(directory-exists? filename)
(bad "exists as directory")])
(parameterize ([rendered-dirpath dirpathlist])
(printf " ~a\n" path)
(renderer filename))))))
(cond
[(pair? ps)
(unless (directory-exists? (car ps))
(if (or (file-exists? (car ps)) (link-exists? (car ps)))
(bad "exists as a file/link")
(make-directory (car ps))))
(parameterize ([current-directory (car ps)])
(loop (cdr ps)))]
[else
(cond
[(not exists)] ; do nothing
[(or (file-exists? filename) (link-exists? filename)) (delete-file filename)]
[(directory-exists? filename) (bad "exists as directory")])
(parameterize ([rendered-dirpath dirpathlist])
(printf " ~a\n" path)
(renderer filename))])))
(define absolute-url
(lazy (define url (relativize filename dirpathlist '()))
(if (url-roots)
Expand Down
21 changes: 10 additions & 11 deletions scribble-html-lib/scribble/html/xml.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,8 @@

;; XML-like objects and functions, with rendering

(require scribble/text racket/port)
(require racket/port
scribble/text)

;; ----------------------------------------------------------------------------
;; Represent attribute names as `foo:' symbols. They are made self-quoting in
Expand Down Expand Up @@ -106,16 +107,14 @@
;; null body means a lone tag, tags that should always have a closer will
;; have a '(#f) as their body (see below)
(list (with-writer #f "<" tag)
(map (lambda (attr)
(define name (car attr))
(define val (cdr attr))
(cond [(not val) #f]
;; #t means just mention the attribute
[(eq? #t val) (with-writer #f (list " " name))]
[else (list (with-writer #f (list " " name "=\""))
val
(with-writer #f "\""))]))
attrs)
(for/list ([attr (in-list attrs)])
(define name (car attr))
(define val (cdr attr))
(cond
[(not val) #f]
;; #t means just mention the attribute
[(eq? #t val) (with-writer #f (list " " name))]
[else (list (with-writer #f (list " " name "=\"")) val (with-writer #f "\""))]))
(if (null? body)
(with-writer #f " />")
(list (with-writer #f ">")
Expand Down
6 changes: 3 additions & 3 deletions scribble-lib/scriblib/figure.rkt
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
#lang racket/base
(require racket/contract/base
scribble/manual
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
scribble/manual
scribble/private/lang-parameters
setup/main-collects
"private/counter.rkt"
scribble/private/lang-parameters)
"private/counter.rkt")

(provide figure
figure*
Expand Down
43 changes: 16 additions & 27 deletions scribble-lib/scriblib/footnote.rkt
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
#lang racket/base

(require scribble/core
(require racket/promise
scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
racket/promise
setup/main-collects
"private/counter.rkt")

Expand Down Expand Up @@ -44,27 +44,19 @@
(define (footnote-part . text) (do-footnote-part footnotes id))))

(define (do-footnote footnotes id text)
(let ([tag (generated-tag)]
[content (decode-content text)])
(make-traverse-element
(lambda (get set)
(set id (cons (cons
(make-element footnote-target-style
(make-element
'superscript
(counter-target footnotes tag #f)))
(define tag (generated-tag))
(define content (decode-content text))
(make-traverse-element
(lambda (get set)
(set id
(cons (cons (make-element footnote-target-style
(make-element 'superscript (counter-target footnotes tag #f)))
content)
(get id null)))
(make-element footnote-style
(list
(make-element
footnote-ref-style
(make-element
'superscript
(counter-ref footnotes tag #f)))
(make-element
footnote-content-style
content)))))))
(get id null)))
(make-element footnote-style
(list (make-element footnote-ref-style
(make-element 'superscript (counter-ref footnotes tag #f)))
(make-element footnote-content-style content))))))

(define (do-footnote-part footnotes id)
(make-part
Expand All @@ -78,9 +70,6 @@
(lambda (get set)
(make-compound-paragraph
footnote-block-style
(map (lambda (content)
(make-paragraph
footnote-block-content-style
content))
(reverse (get id null)))))))
(for/list ([content (in-list (reverse (get id null)))])
(make-paragraph footnote-block-content-style content))))))
null))
Loading