Skip to content

WIP: add option to output xexpr of html (new source branch) #519

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

Draft
wants to merge 11 commits into
base: master
Choose a base branch
from

Conversation

stevebyan
Copy link
Contributor

Output the body as an xexpr, and provide various metadata, including TOC links, in a struct rather than in html.

I've refactored html-render.rkt to optionally output the body of the document as an xexpr rather than as html, and provide document metadata including the TOC links in a struct rather than in html. My goal is to allow use of scribble's html in something like Greg Hendershott's Tadpole, and so I want to provide the document content in a form that can be applied to an xexpr template. I also want to provide the TOC links in a form that can be rendered by site templates using pure CSS to provide a responsive view of the navigation links.

I'm submitting this pull request to gather some feedback on my approach, before committing to doing more work to make this something actually mergeable into Scribble. To pull out the TOC as data rather than as html, I've duplicated a lot of code from the render-toc-view and render-onthispage-contents methods. A finished pull request would refactor render-toc-view and render-onthispage-contents to use the output of my list-of-toc-view and list-of-onthispage-contents. I'm also not sure at this point how I want to represent the TOC contents. Using structs would probably be better than the current hacked nested lists.

Is this a feature the Racket developers would consider including in Scribble? Except for the duplicated code, does my implementation approach look reasonable?

Supercedes PR #498
I mistakenly created the PR from the master branch in my fork. Now that a number of commits have been made to racket/scribble master, I need to reset my master back, pull the new commits, and merge in the new commits to my pull request.

@stevebyan stevebyan marked this pull request as draft June 27, 2025 15:48
Copy link

@github-actions github-actions bot left a comment

Choose a reason for hiding this comment

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

Resyntax analyzed 4 files in this pull request and has added suggestions.

Comment on lines +854 to +859
(map (lambda (p) (if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden)
(all-toc-hidden? p)))
null
(flatten p prefixes #f)))
(part-parts d)))))))

Choose a reason for hiding this comment

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

map-to-for: This map operation can be replaced with a for/list loop.

Suggested change
(map (lambda (p) (if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden)
(all-toc-hidden? p)))
null
(flatten p prefixes #f)))
(part-parts d)))))))
(for/list ([p (in-list (part-parts d))])
(if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden) (all-toc-hidden? p)))
null
(flatten p prefixes #f))))))))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("                  (for/list ([p (in-list (part-parts d))])"
       "                    (if (or (part-whole-page? p ri)"
       "                            (and (part-style? p 'toc-hidden) (all-toc-hidden? p)))"
       "                        null"
       "                        (flatten p prefixes #f))))))))")
  #:original-lines
    '#("                  (map (lambda (p) (if (or (part-whole-page? p ri) "
       "                                           (and (part-style? p 'toc-hidden)"
       "                                                (all-toc-hidden? p)))"
       "                                       null"
       "                                       (flatten p prefixes #f)))"
       "                       (part-parts d)))))))")
  #:start-line 854)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/8.17.0.6/pkgs/resyntax/default-recommendations/for-loop-shortcuts.rkt:157:2 (for/list ((p (in-list (part-parts d)))) (if (or (part-whole-page? p ri) (and (part-style? p (quote toc-hidden)) (all-toc-hidden? p))) null (flatten p prefixes #f)))>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:854:18 (map (lambda (p) (if (or (part-whole-page? p ri) (and (part-style? p (quote toc-hidden)) (all-toc-hidden? p))) null (flatten p prefixes #f))) (part-parts d))>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Comment on lines 866 to 910
(map (lambda (p)
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list
(if (part? p)
(format-number
(collected-info-number
(part-collected-info p ri))
null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p)
from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list
(uri-unreserved-encode
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes)))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])

(render-content
(if (part? p)
(strip-aux
(or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d ri)))))))
ps)))))

Choose a reason for hiding this comment

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

map-to-for: This map operation can be replaced with a for/list loop.

Suggested change
(map (lambda (p)
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list
(if (part? p)
(format-number
(collected-info-number
(part-collected-info p ri))
null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p)
from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list
(uri-unreserved-encode
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes)))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])
(render-content
(if (part? p)
(strip-aux
(or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d ri)))))))
ps)))))
(for/list ([p (in-list ps)])
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes (lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list (if (part? p)
(format-number (collected-info-number (part-collected-info p ri)) null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p) from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list (uri-unreserved-encode
(anchor-name (add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes)))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])
(render-content (if (part? p)
(strip-aux (or (part-title-content p) "???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d
ri)))))))))))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("               (for/list ([p (in-list ps)])"
       "                 (let ([p (vector-ref p 0)]"
       "                       [prefixes (vector-ref p 1)]"
       "                       [from-d (vector-ref p 2)]"
       "                       [add-tag-prefixes (lambda (t prefixes)"
       "                                           (if (null? prefixes)"
       "                                               t"
       "                                               (cons (car t) (append prefixes (cdr t)))))])"
       "                   (list (if (part? p)"
       "                             (format-number (collected-info-number (part-collected-info p ri)) null)"
       "                             null)"
       "                         (if (toc-element? p)"
       "                             (render-content (toc-element-toc-content p) from-d ri)"
       "                             (parameterize ([current-no-links #t]"
       "                                            [extra-breaking? #t])"
       "                               (list (uri-unreserved-encode"
       "                                      (anchor-name (add-tag-prefixes"
       "                                                    (tag-key (if (part? p)"
       "                                                                 (car (part-tags/nonempty p))"
       "                                                                 (target-element-tag p))"
       "                                                             ri)"
       "                                                    prefixes)))"
       "                                     (cond"
       "                                       [(part? p) \"tocsubseclink\"]"
       "                                       [any-parts? \"tocsubnonseclink\"]"
       "                                       [else \"tocsublink\"])"
       "                                     (render-content (if (part? p)"
       "                                                         (strip-aux (or (part-title-content p) \"???\"))"
       "                                                         (if (toc-target2-element? p)"
       "                                                             (toc-target2-element-toc-content p)"
       "                                                             (element-content p)))"
       "                                                     from-d"
       "                                                     ri)))))))))))")
  #:original-lines
    '#("               (map (lambda (p)"
       "                      (let ([p (vector-ref p 0)]"
       "                            [prefixes (vector-ref p 1)]"
       "                            [from-d (vector-ref p 2)]"
       "                            [add-tag-prefixes"
       "                             (lambda (t prefixes)"
       "                               (if (null? prefixes)"
       "                                   t"
       "                                   (cons (car t) (append prefixes (cdr t)))))])"
       "                        (list"
       "                         (if (part? p)"
       "                             (format-number"
       "                              (collected-info-number"
       "                               (part-collected-info p ri))"
       "                              null)"
       "                             null)"
       "                         (if (toc-element? p)"
       "                             (render-content (toc-element-toc-content p)"
       "                                             from-d ri)"
       "                             (parameterize ([current-no-links #t]"
       "                                            [extra-breaking? #t])"
       "                               (list "
       "                                (uri-unreserved-encode"
       "                                 (anchor-name"
       "                                  (add-tag-prefixes"
       "                                   (tag-key (if (part? p)"
       "                                                (car (part-tags/nonempty p))"
       "                                                (target-element-tag p))"
       "                                            ri)"
       "                                   prefixes)))"
       "                                (cond"
       "                                  [(part? p) \"tocsubseclink\"]"
       "                                  [any-parts? \"tocsubnonseclink\"]"
       "                                  [else \"tocsublink\"])"
       "                                        "
       "                                (render-content"
       "                                 (if (part? p)"
       "                                     (strip-aux"
       "                                      (or (part-title-content p)"
       "                                          \"???\"))"
       "                                     (if (toc-target2-element? p)"
       "                                         (toc-target2-element-toc-content p)"
       "                                         (element-content p)))"
       "                                 from-d ri)))))))"
       "                    ps)))))")
  #:start-line 866)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/8.17.0.6/pkgs/resyntax/default-recommendations/for-loop-shortcuts.rkt:157:2 (for/list ((p (in-list ps))) (let ((p (vector-ref p 0)) (prefixes (vector-ref p 1)) (from-d (vector-ref p 2)) (add-tag-prefixes (lambda (t prefixes) (if (null? prefixes) t (cons (car t) (append prefixes (cdr t))))))) (list (if (part? p) (format-number (...>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:866:15 (map (lambda (p) (let ((p (vector-ref p 0)) (prefixes (vector-ref p 1)) (from-d (vector-ref p 2)) (add-tag-prefixes (lambda (t prefixes) (if (null? prefixes) t (cons (car t) (append prefixes (cdr t))))))) (list (if (part? p) (format-number (collected-in...>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Comment on lines 2232 to 2243
(let ([fn (if (depth . < . directory-depth)
(path->string (build-path base "index.html"))
(format "~a.html" base))])
(path->string
(build-path base
(path-replace-extension (string->path "index")
(super get-suffix))))
(format
(string-append "~a"
(path->string
(bytes->path (super get-suffix)))) base))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn)))

Choose a reason for hiding this comment

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

let-to-define: Internal definitions are recommended instead of let expressions, to reduce nesting.

Suggested change
(let ([fn (if (depth . < . directory-depth)
(path->string (build-path base "index.html"))
(format "~a.html" base))])
(path->string
(build-path base
(path-replace-extension (string->path "index")
(super get-suffix))))
(format
(string-append "~a"
(path->string
(bytes->path (super get-suffix)))) base))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn)))
(define fn
(if (depth . < . directory-depth)
(path->string
(build-path base (path-replace-extension (string->path "index") (super get-suffix))))
(format (string-append "~a" (path->string (bytes->path (super get-suffix)))) base)))
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("        (define fn"
       "          (if (depth . < . directory-depth)"
       "              (path->string"
       "               (build-path base (path-replace-extension (string->path \"index\") (super get-suffix))))"
       "              (format (string-append \"~a\" (path->string (bytes->path (super get-suffix)))) base)))"
       "        (when ((string-length fn) . >= . 48)"
       "          (error \"file name too long (need a tag):\" fn))"
       "        fn))")
  #:original-lines
    '#("        (let ([fn (if (depth . < . directory-depth)"
       "                      (path->string"
       "                       (build-path base"
       "                                   (path-replace-extension (string->path \"index\")"
       "                                                           (super get-suffix))))"
       "                      (format"
       "                       (string-append \"~a\""
       "                                      (path->string"
       "                                       (bytes->path (super get-suffix)))) base))])"
       "          (when ((string-length fn) . >= . 48)"
       "            (error \"file name too long (need a tag):\" fn))"
       "          fn)))")
  #:start-line 2232)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:.../resyntax/base.rkt:183:28 (let ((base (regexp-replace* "[^-a-zA-Z0-9_=]" (string-append (append-part-prefixes d ci ri) (let ((s (cadr (car (part-tags/nonempty d))))) (cond ((string? s) s) ((part-title-content d) (content->string (part-title-content d))) (else (format "???~a" (eq...>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:2220:6 (let ((base (regexp-replace* "[^-a-zA-Z0-9_=]" (string-append (append-part-prefixes d ci ri) (let ((s (cadr (car (part-tags/nonempty d))))) (cond ((string? s) s) ((part-title-content d) (content->string (part-title-content d))) (else (format "???~a" (eq...>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

@LiberalArtist
Copy link
Contributor

FYI, you can now change this:


to something like:

["base" #:version "8.17.0.5"] ; for serializable X-expressions

to tell the package system you need a version including the serializable-X-expressions change.

Eventually, you will also want to increment the package version here:

(define version "1.55")

and add @history[] notes to the documentation so that other people can depend on your new feature.

@stevebyan
Copy link
Contributor Author

@LiberalArtist, thank you

Copy link

@github-actions github-actions bot left a comment

Choose a reason for hiding this comment

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

Resyntax analyzed 4 files in this pull request and has added suggestions.

Comment on lines +854 to +859
(map (lambda (p) (if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden)
(all-toc-hidden? p)))
null
(flatten p prefixes #f)))
(part-parts d)))))))
Copy link

Choose a reason for hiding this comment

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

map-to-for: This map operation can be replaced with a for/list loop.

Suggested change
(map (lambda (p) (if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden)
(all-toc-hidden? p)))
null
(flatten p prefixes #f)))
(part-parts d)))))))
(for/list ([p (in-list (part-parts d))])
(if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden) (all-toc-hidden? p)))
null
(flatten p prefixes #f))))))))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("                  (for/list ([p (in-list (part-parts d))])"
       "                    (if (or (part-whole-page? p ri)"
       "                            (and (part-style? p 'toc-hidden) (all-toc-hidden? p)))"
       "                        null"
       "                        (flatten p prefixes #f))))))))")
  #:original-lines
    '#("                  (map (lambda (p) (if (or (part-whole-page? p ri) "
       "                                           (and (part-style? p 'toc-hidden)"
       "                                                (all-toc-hidden? p)))"
       "                                       null"
       "                                       (flatten p prefixes #f)))"
       "                       (part-parts d)))))))")
  #:start-line 854)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/8.17.0.6/pkgs/resyntax/default-recommendations/for-loop-shortcuts.rkt:157:2 (for/list ((p (in-list (part-parts d)))) (if (or (part-whole-page? p ri) (and (part-style? p (quote toc-hidden)) (all-toc-hidden? p))) null (flatten p prefixes #f)))>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:854:18 (map (lambda (p) (if (or (part-whole-page? p ri) (and (part-style? p (quote toc-hidden)) (all-toc-hidden? p))) null (flatten p prefixes #f))) (part-parts d))>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Comment on lines 866 to 910
(map (lambda (p)
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list
(if (part? p)
(format-number
(collected-info-number
(part-collected-info p ri))
null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p)
from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list
(uri-unreserved-encode
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes)))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])

(render-content
(if (part? p)
(strip-aux
(or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d ri)))))))
ps)))))
Copy link

Choose a reason for hiding this comment

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

map-to-for: This map operation can be replaced with a for/list loop.

Suggested change
(map (lambda (p)
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list
(if (part? p)
(format-number
(collected-info-number
(part-collected-info p ri))
null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p)
from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list
(uri-unreserved-encode
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes)))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])
(render-content
(if (part? p)
(strip-aux
(or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d ri)))))))
ps)))))
(for/list ([p (in-list ps)])
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes (lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list (if (part? p)
(format-number (collected-info-number (part-collected-info p ri)) null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p) from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list (uri-unreserved-encode
(anchor-name (add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes)))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])
(render-content (if (part? p)
(strip-aux (or (part-title-content p) "???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d
ri)))))))))))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("               (for/list ([p (in-list ps)])"
       "                 (let ([p (vector-ref p 0)]"
       "                       [prefixes (vector-ref p 1)]"
       "                       [from-d (vector-ref p 2)]"
       "                       [add-tag-prefixes (lambda (t prefixes)"
       "                                           (if (null? prefixes)"
       "                                               t"
       "                                               (cons (car t) (append prefixes (cdr t)))))])"
       "                   (list (if (part? p)"
       "                             (format-number (collected-info-number (part-collected-info p ri)) null)"
       "                             null)"
       "                         (if (toc-element? p)"
       "                             (render-content (toc-element-toc-content p) from-d ri)"
       "                             (parameterize ([current-no-links #t]"
       "                                            [extra-breaking? #t])"
       "                               (list (uri-unreserved-encode"
       "                                      (anchor-name (add-tag-prefixes"
       "                                                    (tag-key (if (part? p)"
       "                                                                 (car (part-tags/nonempty p))"
       "                                                                 (target-element-tag p))"
       "                                                             ri)"
       "                                                    prefixes)))"
       "                                     (cond"
       "                                       [(part? p) \"tocsubseclink\"]"
       "                                       [any-parts? \"tocsubnonseclink\"]"
       "                                       [else \"tocsublink\"])"
       "                                     (render-content (if (part? p)"
       "                                                         (strip-aux (or (part-title-content p) \"???\"))"
       "                                                         (if (toc-target2-element? p)"
       "                                                             (toc-target2-element-toc-content p)"
       "                                                             (element-content p)))"
       "                                                     from-d"
       "                                                     ri)))))))))))")
  #:original-lines
    '#("               (map (lambda (p)"
       "                      (let ([p (vector-ref p 0)]"
       "                            [prefixes (vector-ref p 1)]"
       "                            [from-d (vector-ref p 2)]"
       "                            [add-tag-prefixes"
       "                             (lambda (t prefixes)"
       "                               (if (null? prefixes)"
       "                                   t"
       "                                   (cons (car t) (append prefixes (cdr t)))))])"
       "                        (list"
       "                         (if (part? p)"
       "                             (format-number"
       "                              (collected-info-number"
       "                               (part-collected-info p ri))"
       "                              null)"
       "                             null)"
       "                         (if (toc-element? p)"
       "                             (render-content (toc-element-toc-content p)"
       "                                             from-d ri)"
       "                             (parameterize ([current-no-links #t]"
       "                                            [extra-breaking? #t])"
       "                               (list "
       "                                (uri-unreserved-encode"
       "                                 (anchor-name"
       "                                  (add-tag-prefixes"
       "                                   (tag-key (if (part? p)"
       "                                                (car (part-tags/nonempty p))"
       "                                                (target-element-tag p))"
       "                                            ri)"
       "                                   prefixes)))"
       "                                (cond"
       "                                  [(part? p) \"tocsubseclink\"]"
       "                                  [any-parts? \"tocsubnonseclink\"]"
       "                                  [else \"tocsublink\"])"
       "                                        "
       "                                (render-content"
       "                                 (if (part? p)"
       "                                     (strip-aux"
       "                                      (or (part-title-content p)"
       "                                          \"???\"))"
       "                                     (if (toc-target2-element? p)"
       "                                         (toc-target2-element-toc-content p)"
       "                                         (element-content p)))"
       "                                 from-d ri)))))))"
       "                    ps)))))")
  #:start-line 866)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/8.17.0.6/pkgs/resyntax/default-recommendations/for-loop-shortcuts.rkt:157:2 (for/list ((p (in-list ps))) (let ((p (vector-ref p 0)) (prefixes (vector-ref p 1)) (from-d (vector-ref p 2)) (add-tag-prefixes (lambda (t prefixes) (if (null? prefixes) t (cons (car t) (append prefixes (cdr t))))))) (list (if (part? p) (format-number (...>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:866:15 (map (lambda (p) (let ((p (vector-ref p 0)) (prefixes (vector-ref p 1)) (from-d (vector-ref p 2)) (add-tag-prefixes (lambda (t prefixes) (if (null? prefixes) t (cons (car t) (append prefixes (cdr t))))))) (list (if (part? p) (format-number (collected-in...>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Comment on lines 2240 to 2251
(let ([fn (if (depth . < . directory-depth)
(path->string (build-path base "index.html"))
(format "~a.html" base))])
(path->string
(build-path base
(path-replace-extension (string->path "index")
(super get-suffix))))
(format
(string-append "~a"
(path->string
(bytes->path (super get-suffix)))) base))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn)))
Copy link

Choose a reason for hiding this comment

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

let-to-define: Internal definitions are recommended instead of let expressions, to reduce nesting.

Suggested change
(let ([fn (if (depth . < . directory-depth)
(path->string (build-path base "index.html"))
(format "~a.html" base))])
(path->string
(build-path base
(path-replace-extension (string->path "index")
(super get-suffix))))
(format
(string-append "~a"
(path->string
(bytes->path (super get-suffix)))) base))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn)))
(define fn
(if (depth . < . directory-depth)
(path->string
(build-path base (path-replace-extension (string->path "index") (super get-suffix))))
(format (string-append "~a" (path->string (bytes->path (super get-suffix)))) base)))
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("        (define fn"
       "          (if (depth . < . directory-depth)"
       "              (path->string"
       "               (build-path base (path-replace-extension (string->path \"index\") (super get-suffix))))"
       "              (format (string-append \"~a\" (path->string (bytes->path (super get-suffix)))) base)))"
       "        (when ((string-length fn) . >= . 48)"
       "          (error \"file name too long (need a tag):\" fn))"
       "        fn))")
  #:original-lines
    '#("        (let ([fn (if (depth . < . directory-depth)"
       "                      (path->string"
       "                       (build-path base"
       "                                   (path-replace-extension (string->path \"index\")"
       "                                                           (super get-suffix))))"
       "                      (format"
       "                       (string-append \"~a\""
       "                                      (path->string"
       "                                       (bytes->path (super get-suffix)))) base))])"
       "          (when ((string-length fn) . >= . 48)"
       "            (error \"file name too long (need a tag):\" fn))"
       "          fn)))")
  #:start-line 2240)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:.../resyntax/base.rkt:183:28 (let ((base (regexp-replace* "[^-a-zA-Z0-9_=]" (string-append (append-part-prefixes d ci ri) (let ((s (cadr (car (part-tags/nonempty d))))) (cond ((string? s) s) ((part-title-content d) (content->string (part-title-content d))) (else (format "???~a" (eq...>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:2228:6 (let ((base (regexp-replace* "[^-a-zA-Z0-9_=]" (string-append (append-part-prefixes d ci ri) (let ((s (cadr (car (part-tags/nonempty d))))) (cond ((string? s) s) ((part-title-content d) (content->string (part-title-content d))) (else (format "???~a" (eq...>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

temporary code, for investigation of toc structure
Copy link

@github-actions github-actions bot left a comment

Choose a reason for hiding this comment

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

Resyntax analyzed 4 files in this pull request and has added suggestions.

Comment on lines +855 to +860
(map (lambda (p) (if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden)
(all-toc-hidden? p)))
null
(flatten p prefixes #f)))
(part-parts d)))))))

Choose a reason for hiding this comment

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

map-to-for: This map operation can be replaced with a for/list loop.

Suggested change
(map (lambda (p) (if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden)
(all-toc-hidden? p)))
null
(flatten p prefixes #f)))
(part-parts d)))))))
(for/list ([p (in-list (part-parts d))])
(if (or (part-whole-page? p ri)
(and (part-style? p 'toc-hidden) (all-toc-hidden? p)))
null
(flatten p prefixes #f))))))))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("                  (for/list ([p (in-list (part-parts d))])"
       "                    (if (or (part-whole-page? p ri)"
       "                            (and (part-style? p 'toc-hidden) (all-toc-hidden? p)))"
       "                        null"
       "                        (flatten p prefixes #f))))))))")
  #:original-lines
    '#("                  (map (lambda (p) (if (or (part-whole-page? p ri) "
       "                                           (and (part-style? p 'toc-hidden)"
       "                                                (all-toc-hidden? p)))"
       "                                       null"
       "                                       (flatten p prefixes #f)))"
       "                       (part-parts d)))))))")
  #:start-line 855)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/8.17.0.6/pkgs/resyntax/default-recommendations/for-loop-shortcuts.rkt:157:2 (for/list ((p (in-list (part-parts d)))) (if (or (part-whole-page? p ri) (and (part-style? p (quote toc-hidden)) (all-toc-hidden? p))) null (flatten p prefixes #f)))>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:855:18 (map (lambda (p) (if (or (part-whole-page? p ri) (and (part-style? p (quote toc-hidden)) (all-toc-hidden? p))) null (flatten p prefixes #f))) (part-parts d))>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Comment on lines +869 to +915
(map (lambda (p)
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list
(if (part? p)
(format-number
(collected-info-number
(part-collected-info p ri))
null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p)
from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list
(format
"#~a"
(uri-unreserved-encode
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes))))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])

(render-content
(if (part? p)
(strip-aux
(or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d ri)))))))
ps))))))

Choose a reason for hiding this comment

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

map-to-for: This map operation can be replaced with a for/list loop.

Suggested change
(map (lambda (p)
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes
(lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list
(if (part? p)
(format-number
(collected-info-number
(part-collected-info p ri))
null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p)
from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list
(format
"#~a"
(uri-unreserved-encode
(anchor-name
(add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes))))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])
(render-content
(if (part? p)
(strip-aux
(or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d ri)))))))
ps))))))
(for/list ([p (in-list ps)])
(let ([p (vector-ref p 0)]
[prefixes (vector-ref p 1)]
[from-d (vector-ref p 2)]
[add-tag-prefixes (lambda (t prefixes)
(if (null? prefixes)
t
(cons (car t) (append prefixes (cdr t)))))])
(list (if (part? p)
(format-number (collected-info-number (part-collected-info p ri)) null)
null)
(if (toc-element? p)
(render-content (toc-element-toc-content p) from-d ri)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
(list (format "#~a"
(uri-unreserved-encode
(anchor-name (add-tag-prefixes
(tag-key (if (part? p)
(car (part-tags/nonempty p))
(target-element-tag p))
ri)
prefixes))))
(cond
[(part? p) "tocsubseclink"]
[any-parts? "tocsubnonseclink"]
[else "tocsublink"])
(render-content (if (part? p)
(strip-aux (or (part-title-content p)
"???"))
(if (toc-target2-element? p)
(toc-target2-element-toc-content p)
(element-content p)))
from-d
ri))))))))))))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("                (for/list ([p (in-list ps)])"
       "                  (let ([p (vector-ref p 0)]"
       "                        [prefixes (vector-ref p 1)]"
       "                        [from-d (vector-ref p 2)]"
       "                        [add-tag-prefixes (lambda (t prefixes)"
       "                                            (if (null? prefixes)"
       "                                                t"
       "                                                (cons (car t) (append prefixes (cdr t)))))])"
       "                    (list (if (part? p)"
       "                              (format-number (collected-info-number (part-collected-info p ri)) null)"
       "                              null)"
       "                          (if (toc-element? p)"
       "                              (render-content (toc-element-toc-content p) from-d ri)"
       "                              (parameterize ([current-no-links #t]"
       "                                             [extra-breaking? #t])"
       "                                (list (format \"#~a\""
       "                                              (uri-unreserved-encode"
       "                                               (anchor-name (add-tag-prefixes"
       "                                                             (tag-key (if (part? p)"
       "                                                                          (car (part-tags/nonempty p))"
       "                                                                          (target-element-tag p))"
       "                                                                      ri)"
       "                                                             prefixes))))"
       "                                      (cond"
       "                                        [(part? p) \"tocsubseclink\"]"
       "                                        [any-parts? \"tocsubnonseclink\"]"
       "                                        [else \"tocsublink\"])"
       "                                      (render-content (if (part? p)"
       "                                                          (strip-aux (or (part-title-content p)"
       "                                                                         \"???\"))"
       "                                                          (if (toc-target2-element? p)"
       "                                                              (toc-target2-element-toc-content p)"
       "                                                              (element-content p)))"
       "                                                      from-d"
       "                                                      ri))))))))))))")
  #:original-lines
    '#("                (map (lambda (p)"
       "                       (let ([p (vector-ref p 0)]"
       "                             [prefixes (vector-ref p 1)]"
       "                             [from-d (vector-ref p 2)]"
       "                             [add-tag-prefixes"
       "                              (lambda (t prefixes)"
       "                                (if (null? prefixes)"
       "                                    t"
       "                                    (cons (car t) (append prefixes (cdr t)))))])"
       "                         (list"
       "                          (if (part? p)"
       "                              (format-number"
       "                               (collected-info-number"
       "                                (part-collected-info p ri))"
       "                               null)"
       "                              null)"
       "                          (if (toc-element? p)"
       "                              (render-content (toc-element-toc-content p)"
       "                                              from-d ri)"
       "                              (parameterize ([current-no-links #t]"
       "                                             [extra-breaking? #t])"
       "                                (list "
       "                                 (format"
       "                                  \"#~a\""
       "                                  (uri-unreserved-encode"
       "                                   (anchor-name"
       "                                    (add-tag-prefixes"
       "                                     (tag-key (if (part? p)"
       "                                                  (car (part-tags/nonempty p))"
       "                                                  (target-element-tag p))"
       "                                              ri)"
       "                                     prefixes))))"
       "                                 (cond"
       "                                   [(part? p) \"tocsubseclink\"]"
       "                                   [any-parts? \"tocsubnonseclink\"]"
       "                                   [else \"tocsublink\"])"
       "                                        "
       "                                 (render-content"
       "                                  (if (part? p)"
       "                                      (strip-aux"
       "                                       (or (part-title-content p)"
       "                                           \"???\"))"
       "                                      (if (toc-target2-element? p)"
       "                                          (toc-target2-element-toc-content p)"
       "                                          (element-content p)))"
       "                                  from-d ri)))))))"
       "                     ps))))))")
  #:start-line 869)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/8.17.0.6/pkgs/resyntax/default-recommendations/for-loop-shortcuts.rkt:157:2 (for/list ((p (in-list ps))) (let ((p (vector-ref p 0)) (prefixes (vector-ref p 1)) (from-d (vector-ref p 2)) (add-tag-prefixes (lambda (t prefixes) (if (null? prefixes) t (cons (car t) (append prefixes (cdr t))))))) (list (if (part? p) (format-number (...>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:869:16 (map (lambda (p) (let ((p (vector-ref p 0)) (prefixes (vector-ref p 1)) (from-d (vector-ref p 2)) (add-tag-prefixes (lambda (t prefixes) (if (null? prefixes) t (cons (car t) (append prefixes (cdr t))))))) (list (if (part? p) (format-number (collected-in...>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Comment on lines 2248 to 2259
(let ([fn (if (depth . < . directory-depth)
(path->string (build-path base "index.html"))
(format "~a.html" base))])
(path->string
(build-path base
(path-replace-extension (string->path "index")
(super get-suffix))))
(format
(string-append "~a"
(path->string
(bytes->path (super get-suffix)))) base))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn)))

Choose a reason for hiding this comment

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

let-to-define: Internal definitions are recommended instead of let expressions, to reduce nesting.

Suggested change
(let ([fn (if (depth . < . directory-depth)
(path->string (build-path base "index.html"))
(format "~a.html" base))])
(path->string
(build-path base
(path-replace-extension (string->path "index")
(super get-suffix))))
(format
(string-append "~a"
(path->string
(bytes->path (super get-suffix)))) base))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn)))
(define fn
(if (depth . < . directory-depth)
(path->string
(build-path base (path-replace-extension (string->path "index") (super get-suffix))))
(format (string-append "~a" (path->string (bytes->path (super get-suffix)))) base)))
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
fn))
Debugging details
Textual replacement
(line-replacement
  #:new-lines
    '#("        (define fn"
       "          (if (depth . < . directory-depth)"
       "              (path->string"
       "               (build-path base (path-replace-extension (string->path \"index\") (super get-suffix))))"
       "              (format (string-append \"~a\" (path->string (bytes->path (super get-suffix)))) base)))"
       "        (when ((string-length fn) . >= . 48)"
       "          (error \"file name too long (need a tag):\" fn))"
       "        fn))")
  #:original-lines
    '#("        (let ([fn (if (depth . < . directory-depth)"
       "                      (path->string"
       "                       (build-path base"
       "                                   (path-replace-extension (string->path \"index\")"
       "                                                           (super get-suffix))))"
       "                      (format"
       "                       (string-append \"~a\""
       "                                      (path->string"
       "                                       (bytes->path (super get-suffix)))) base))])"
       "          (when ((string-length fn) . >= . 48)"
       "            (error \"file name too long (need a tag):\" fn))"
       "          fn)))")
  #:start-line 2248)
Syntactic replacement
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:.../resyntax/base.rkt:183:28 (let ((base (regexp-replace* "[^-a-zA-Z0-9_=]" (string-append (append-part-prefixes d ci ri) (let ((s (cadr (car (part-tags/nonempty d))))) (cond ((string? s) s) ((part-title-content d) (content->string (part-title-content d))) (else (format "???~a" (eq...>
  #:original-syntax
    #<syntax:scribble-lib/scribble/html-render.rkt:2236:6 (let ((base (regexp-replace* "[^-a-zA-Z0-9_=]" (string-append (append-part-prefixes d ci ri) (let ((s (cadr (car (part-tags/nonempty d))))) (cond ((string? s) s) ((part-title-content d) (content->string (part-title-content d))) (else (format "???~a" (eq...>
  #:source
    (file-source
     #<path:/home/runner/work/scribble/scribble/scribble-lib/scribble/html-render.rkt>))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

Successfully merging this pull request may close these issues.

2 participants