diff --git a/scribble-doc/scribblings/scribble/core.scrbl b/scribble-doc/scribblings/scribble/core.scrbl
index ab2b1b9129..ba6e867492 100644
--- a/scribble-doc/scribblings/scribble/core.scrbl
+++ b/scribble-doc/scribblings/scribble/core.scrbl
@@ -1114,10 +1114,26 @@ property}:
Instead, the word ``section'' is shown followed by a
hyperlinked section number. The word ``section'' starts in
uppercase if the element's style includes a @racket['uppercase]
- property.}
+ property.
+
+ In @racket['short] mode, only the section number is shown, as
+ ``§3.2'', the whole thing (symbol and number together)
+ hyperlinked as a unit --- no word, no title.
+
+ In @racket['number-and-title] mode, both the number and the
+ title are shown together, hyperlinked as a unit: the section
+ number (if the section has one), the symbol ``§'', and the
+ section title in quotes --- e.g., ``§3.2 “Some Section”''.
+
+ For both @racket['short] and @racket['number-and-title], a
+ section with no number (e.g., an @racket['unnumbered] part)
+ falls back instead to just the title, with no ``§'' or number:
+ quoted for @racket['number-and-title], plain for
+ @racket['short].}
@item{For Latex/PDF output, the generated reference's format can
- depend on the document style in addition the @racket[_mode].
+ depend on the document style in addition the @racket[_mode],
+ for the @racket['default] and @racket['number] modes.
For the @racket['default] mode and a default document style, a
section number is shown by the word ``section'' followed by the
section number, and the word ``section'' and the section number
@@ -1130,10 +1146,17 @@ property}:
only the number is hyperlinked, not the word ``section'' or
the ``§'' symbol.
- A new document style can customize Latex/PDF output (see
- @secref["config"]) by redefining the @ltx{SecRefLocal}, @|etc|,
- macros (see @secref["builtin-latex"]). The @ltx{SecRef},
- @|etc|, variants are used in @racket['number] mode.}
+ A new document style can customize this part of Latex/PDF
+ output (see @secref["config"]) by redefining the
+ @ltx{SecRefLocal}, @|etc|, macros (see
+ @secref["builtin-latex"]). The @ltx{SecRef}, @|etc|, variants
+ are used in @racket['number] mode.
+
+ The @racket['short] and @racket['number-and-title] modes
+ render the same way as they do for HTML (described above),
+ @emph{regardless} of the document style: they bypass the
+ @ltx{SecRefLocal} macro family entirely, so a document style
+ cannot customize their appearance by redefining those macros.}
]
@@ -1172,7 +1195,9 @@ properties for all @racket[element]s:
]
@history[#:changed "1.26" @elem{Added @racket[link-render-style] support.}
- #:changed "1.65" @elem{Added @racket[link-query-addition] support.}]}
+ #:changed "1.65" @elem{Added @racket[link-query-addition] support.}
+ #:changed "1.69" @elem{Added the @racket['short] and
+ @racket['number-and-title] modes.}]}
@defstruct[(index-element element) ([tag tag?]
@@ -1640,7 +1665,7 @@ subsection numbers. See also @racket[collected-info].
@history[#:added "1.1"]}
-@defstruct[link-render-style ([mode (or/c 'default 'number)])]{
+@defstruct[link-render-style ([mode (or/c 'default 'number 'short 'number-and-title)])]{
Used as a @tech{style property} for a @racket[part] or a specific
@racket[link-element] to control the way that a hyperlink is rendered
@@ -1655,7 +1680,16 @@ hyperlinked. The @racket['default] style is more flexible, allowing a
more appropriate choice for the rendering context, such as using the
target section's name for a hyperlink in HTML.
-@history[#:added "1.26"]}
+The @racket['short] mode shows just the number, as ``§3.2''; the
+@racket['number-and-title] mode shows the number and the title
+together, as ``§3.2 “Some Section”''. Both bypass the document style's
+own customization of @racket['default]/@racket['number] rendering; see
+@racket[link-element] for the exact rendering, including how each
+falls back when a section has no number.
+
+@history[#:added "1.26"
+ #:changed "1.69" @elem{Added the @racket['short] and
+ @racket['number-and-title] modes.}]}
@defparam[current-link-render-style style link-render-style?]{
diff --git a/scribble-lib/info.rkt b/scribble-lib/info.rkt
index 02f092ad2e..aff8fe797a 100644
--- a/scribble-lib/info.rkt
+++ b/scribble-lib/info.rkt
@@ -21,7 +21,7 @@
(define pkg-authors '(mflatt eli))
-(define version "1.68")
+(define version "1.69")
(define license
'((Apache-2.0 OR MIT)
diff --git a/scribble-lib/scribble/core.rkt b/scribble-lib/scribble/core.rkt
index 5e17bdada6..5253a27af7 100644
--- a/scribble-lib/scribble/core.rkt
+++ b/scribble-lib/scribble/core.rkt
@@ -192,7 +192,7 @@
link-render-style?
link-render-style-mode
(contract-out
- [link-render-style ((or/c 'default 'number)
+ [link-render-style ((or/c 'default 'number 'short 'number-and-title)
. -> . link-render-style?)]
[current-link-render-style (parameter/c link-render-style?)]))
diff --git a/scribble-lib/scribble/html-render.rkt b/scribble-lib/scribble/html-render.rkt
index 5ab2c88866..ba7da08059 100644
--- a/scribble-lib/scribble/html-render.rkt
+++ b/scribble-lib/scribble/html-render.rkt
@@ -1461,15 +1461,30 @@
external-tag-path)
(values #f #f)
(resolve-get/ext-id part ri (link-element-tag e)))]
+ [(has-number?)
+ ;; If the section number is empty, don't generate an
+ ;; empty link:
+ (cond
+ [dest
+ (define n (dest-number dest))
+ (not (or (not n)
+ (string=? "" (apply string-append (format-number n '(""))))))]
+ [else #f])]
[(number-link?)
(and dest
(not ext-id)
- (let ([n (dest-number dest)])
- ;; If the section number is empty, don't generate an
- ;; empty link:
- (not (or (not n)
- (string=? "" (apply string-append (format-number n '("")))))))
+ has-number?
(eq? 'number (link-render-style-at-element e))
+ (empty-content? (element-content e)))]
+ [(short-link?)
+ (and dest
+ (not ext-id)
+ (eq? 'short (link-render-style-at-element e))
+ (empty-content? (element-content e)))]
+ [(number-and-title-link?)
+ (and dest
+ (not ext-id)
+ (eq? 'number-and-title (link-render-style-at-element e))
(empty-content? (element-content e)))])
(define (extract-query)
(let ([s (element-style e)])
@@ -1554,6 +1569,15 @@
,@(if (empty-content? (element-content e))
(cond
[number-link? (format-number (dest-number dest) '(""))]
+ [short-link?
+ (if has-number?
+ `("§" ,@(format-number (dest-number dest) '("")))
+ (render-content (strip-aux (dest-title dest)) part ri))]
+ [number-and-title-link?
+ `(,@(if has-number?
+ `("§" ,@(format-number (dest-number dest) '(" ")))
+ '())
+ "“" ,@(render-content (strip-aux (dest-title dest)) part ri) "”")]
[else
(render-content (strip-aux (dest-title dest)) part ri)])
(render-content (element-content e) part ri))))
diff --git a/scribble-lib/scribble/latex-render.rkt b/scribble-lib/scribble/latex-render.rkt
index ab20f3c58a..f71f957494 100644
--- a/scribble-lib/scribble/latex-render.rkt
+++ b/scribble-lib/scribble/latex-render.rkt
@@ -338,6 +338,54 @@
(printf "\\noindent ")))
(super render-intrapara-block p part ri first? last? starting-item?))
+ ;; Renders an empty-content part link, such as secref, on its own,
+ ;; for the 'short and 'number-and-title link-render-style modes: "§N.M"
+ ;; or "§N.M "Title"". When the section has no number, 'short falls back
+ ;; to the plain title and 'number-and-title to just the quoted title.
+ ;; Bypasses the \SecRef*/\ChapRef* macro family entirely, so it doesn't
+ ;; depend on which .tex style is loaded, unlike 'default and 'number
+ ;; (see render-content below).
+ ;;
+ ;; Builds ordinary content -- "§", the number, the curly-quoted title --
+ ;; and wraps it in a fresh link-element sharing e's tag but with
+ ;; non-empty content. Rendering that recursively through render-content
+ ;; routes it through the ordinary (non-part-label) content path below,
+ ;; which already resolves hyperref? and wraps linked content in
+ ;; \hyperref[...]{...}; so this needs no hyperref/brace bookkeeping of
+ ;; its own, and "§"/curly quotes get the same character-escaping
+ ;; (convert-to-latex) as any other text.
+ ;;
+ ;; dest/ext?/formatted-number are whatever render-content already
+ ;; computed for this element, passed in rather than recomputed.
+ ;; Returns #t if it rendered something, in which case the caller should
+ ;; do nothing else for this element; #f if this element doesn't qualify
+ ;; for self-contained rendering (caller should fall back to the usual
+ ;; part-label rendering).
+ (define/private (render-self-contained-secref e part ri dest ext? formatted-number)
+ (define mode (link-render-style-at-element e))
+ (define ok? (and dest (not ext?) (not (show-link-page-numbers))))
+ (define has-number? (and ok? formatted-number (pair? formatted-number)))
+ (define content
+ (cond
+ [(and ok? (eq? mode 'number-and-title))
+ (append (if has-number? (list "§" formatted-number " ") null)
+ (list "“" (strip-aux (vector-ref dest 0)) "”"))]
+ [(and ok? (eq? mode 'short))
+ (if has-number?
+ (list "§" formatted-number)
+ (strip-aux (vector-ref dest 0)))]
+ [else #f]))
+ (and content
+ (begin
+ ;; Wrap in a list so the replacement link's content is never
+ ;; '() itself (even when e.g. the title being substituted in
+ ;; is itself empty) -- empty-content? is a bare (null? c), so
+ ;; an unwrapped '() here would make the replacement link look
+ ;; like another empty-content part-label link, re-entering
+ ;; this same method indefinitely.
+ (render-content (make-link-element (element-style e) (list content) (link-element-tag e)) part ri)
+ #t)))
+
(define/override (render-content e part ri)
(let ([part-label? (and (link-element? e)
(pair? (link-element-tag e))
@@ -348,271 +396,274 @@
(when (target-element? e)
(printf "\\label{t:~a}"
(t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri)))))
- (when part-label?
- (define-values (dest ext?) (resolve-get/ext? part ri (link-element-tag e)))
- (let* ([number (and dest (vector-ref dest 2))]
- [formatted-number (and dest
- (list? number)
- (format-number number null))]
- [lbl? (and dest
- (not ext?)
- (not (show-link-page-numbers)))]
- [link-number? (and lbl?
- (eq? 'number (link-render-style-at-element e)))])
- (printf "\\~aRef~a~a~a{"
- (case (and dest (number-depth number))
- [(0) "Book"]
- [(1) (if (string? (car number)) "Part" "Chap")]
- [else "Sec"])
- (if (and lbl? (not link-number?))
- "Local"
- "")
- (if (let ([s (element-style e)])
- (and (style? s) (memq 'uppercase (style-properties s))))
- "UC"
- "")
- (if (null? formatted-number)
- "UN"
- ""))
- (when (and lbl? (not link-number?))
- (printf "t:~a}{" (t-encode (vector-ref dest 1))))
- (unless (null? formatted-number)
- (when link-number? (printf "\\SectionNumberLink{t:~a}{" (t-encode (vector-ref dest 1))))
- (render-content
- (if dest
- (if (list? number)
- formatted-number
- (begin (eprintf "Internal tag error: ~s -> ~s\n"
- (link-element-tag e)
- dest)
- '("!!!")))
- (list "???"))
- part ri)
- (when link-number? (printf "}"))
- (printf "}{"))))
- (let* ([es (cond
- [(element? e) (element-style e)]
- [(multiarg-element? e) (multiarg-element-style e)]
- [else #f])]
- [style-name (if (style? es)
- (style-name es)
- es)]
- [style (and (style? es) es)]
- [hyperref? (and (not part-label?)
- (link-element? e)
- (not (disable-hyperref))
- (let-values ([(dest ext?) (resolve-get/ext? part ri (link-element-tag e))])
- (and (not ext?) dest)))]
- [check-render
- (lambda ()
- (when (render-element? e)
- ((render-element-render e) this part ri)))]
- [core-render (lambda (e tt?)
- (cond
- [(and (image-element? e)
- (not (disable-images)))
- (check-render)
- (let ([fn (install-file
- (select-suffix
- (collects-relative->path
- (image-element-path e))
- (image-element-suffixes e)
- '(".pdf" ".ps" ".png")))])
- (printf "\\includegraphics[scale=~a]{~a}"
- (image-element-scale e) fn))]
- [(and (convertible? e)
- (not (disable-images))
- (let ([ftag (lambda (v suffix [scale 1]) (and v (list v suffix scale)))]
- [xxlist (lambda (v) (and v (list v #f #f #f #f #f #f #f #f)))]
- [xlist (lambda (v) (and v (append v (list 0 0 0 0))))])
- (for/or ([req (in-list image-reqs)])
- (case req
- [(eps-bytes)
- (or (ftag (convert e 'eps-bytes+bounds8) ".ps")
- (ftag (xlist (convert e 'eps-bytes+bounds)) ".ps")
- (ftag (xxlist (convert e 'eps-bytes)) ".ps"))]
- [(pdf-bytes)
- (or (ftag (convert e 'pdf-bytes+bounds8) ".pdf")
- (ftag (xlist (convert e 'pdf-bytes+bounds)) ".pdf")
- (ftag (xxlist (convert e 'pdf-bytes)) ".pdf"))]
- [(png@2x-bytes)
- (or (ftag (convert e 'png@2x-bytes+bounds8) ".png" 0.5)
- (ftag (xxlist (convert e 'png@2x-bytes)) ".png" 0.5))]
- [(png-bytes)
- (or (ftag (convert e 'png-bytes+bounds8) ".png")
- (ftag (xxlist (convert e 'png-bytes)) ".png"))]))))
- => (lambda (bstr+info+suffix)
- (check-render)
- (let* ([bstr (list-ref (list-ref bstr+info+suffix 0) 0)]
- [suffix (list-ref bstr+info+suffix 1)]
- [scale (list-ref bstr+info+suffix 2)]
- [height (list-ref (list-ref bstr+info+suffix 0) 2)]
- [pad-left (or (list-ref (list-ref bstr+info+suffix 0) 5) 0)]
- [pad-top (or (list-ref (list-ref bstr+info+suffix 0) 6) 0)]
- [pad-right (or (list-ref (list-ref bstr+info+suffix 0) 7) 0)]
- [pad-bottom (or (list-ref (list-ref bstr+info+suffix 0) 8) 0)]
- [descent (and height
- (- (+ (list-ref (list-ref bstr+info+suffix 0) 3)
- (- (ceiling height) height))
- pad-bottom))]
- [width (let ([w (list-ref (list-ref bstr+info+suffix 0) 1)])
- (and w (- w pad-left pad-right)))]
- [fn (install-file (format "pict~a" suffix) bstr)])
- (if descent
- (printf "\\raisebox{-~abp}{\\makebox[~abp][l]{\\includegraphics[~atrim=~a ~a ~a ~a]{~a}}}"
- descent
- width
- (if (= scale 1) "" (format "scale=~a," scale))
- (/ pad-left scale) (/ pad-bottom scale) (/ pad-right scale) (/ pad-top scale)
- fn)
- (printf "\\includegraphics{~a}" fn))))]
- [else
- (parameterize ([rendering-tt (or tt? (rendering-tt))])
- (super render-content e part ri))]))]
- [wrap (lambda (e s tt?)
- (when s (printf "\\~a{" s))
- (core-render e tt?)
- (when s (printf "}")))])
- (define (finish tt?)
- (cond
- [(symbol? style-name)
- (case style-name
- [(emph) (wrap e "emph" tt?)]
- [(italic) (wrap e "textit" tt?)]
- [(bold) (wrap e "textbf" tt?)]
- [(tt) (wrap e "Scribtexttt" #t)]
- [(url) (wrap e "Snolinkurl" 'url)]
- [(no-break) (wrap e "mbox" tt?)]
- [(sf) (wrap e "textsf" #f)]
- [(roman) (wrap e "textrm" #f)]
- [(subscript) (wrap e "textsub" #f)]
- [(superscript) (wrap e "textsuper" #f)]
- [(smaller) (wrap e "Smaller" #f)]
- [(larger) (wrap e "Larger" #f)]
- [(hspace)
- (check-render)
- (let ([s (content->string e)])
- (case (string-length s)
- [(0) (void)]
- [else
- (printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
- (regexp-replace* #rx"." s "x"))]))]
- [(newline)
- (check-render)
- (unless (suppress-newline-content)
- (printf "\\hspace*{\\fill}\\\\"))]
- [else (error 'latex-render
- "unrecognized style symbol: ~s" style)])]
- [(string? style-name)
- (let* ([v (if style (style-properties style) null)]
- [tt? (cond
- [(memq 'tt-chars v) #t]
- [(memq 'exact-chars v) 'exact]
- [else tt?])])
- (cond
- [(multiarg-element? e)
- (check-render)
- (printf "\\~a" style-name)
- (define maybe-optional-args
- (findf command-optional? (if style (style-properties style) '())))
- (when maybe-optional-args
- (for ([i (in-list (command-optional-arguments maybe-optional-args))])
- (printf "[~a]" i)))
- (if (null? (multiarg-element-contents e))
- (printf "{}")
- (for ([i (in-list (multiarg-element-contents e))])
- (printf "{")
- (parameterize ([rendering-tt (or tt? (rendering-tt))])
- (render-content i part ri))
- (printf "}")))]
- [else
- (define maybe-optional
- (findf command-optional? (if style (style-properties style) '())))
- (if maybe-optional
- (wrap e
- (string-join #:before-first (format "~a[" style-name)
- #:after-last "]"
- (command-optional-arguments maybe-optional)
- "][")
- tt?)
- (wrap e style-name tt?))]))]
- [(and (not style-name)
- style
- (memq 'exact-chars (style-properties style)))
- (wrap e style-name 'exact)]
- [else
- (core-render e tt?)]))
- (when hyperref?
- (printf "\\hyperref[t:~a]{"
- (t-encode (vector-ref hyperref? 1))))
- (let loop ([l (if style (style-properties style) null)] [tt? #f])
- (if (null? l)
- (if hyperref?
- (parameterize ([disable-hyperref #t])
- (finish tt?))
- (finish tt?))
- (let ([v (car l)])
+ (define-values (dest ext?)
+ (if part-label?
+ (resolve-get/ext? part ri (link-element-tag e))
+ (values #f #f)))
+ (define number (and dest (vector-ref dest 2)))
+ (define formatted-number (and dest (list? number) (format-number number null)))
+ (unless (and part-label?
+ (render-self-contained-secref e part ri dest ext? formatted-number))
+ (when part-label?
+ (let* ([lbl? (and dest
+ (not ext?)
+ (not (show-link-page-numbers)))]
+ [link-number? (and lbl?
+ (eq? 'number (link-render-style-at-element e)))])
+ (printf "\\~aRef~a~a~a{"
+ (case (and dest (number-depth number))
+ [(0) "Book"]
+ [(1) (if (string? (car number)) "Part" "Chap")]
+ [else "Sec"])
+ (if (and lbl? (not link-number?))
+ "Local"
+ "")
+ (if (let ([s (element-style e)])
+ (and (style? s) (memq 'uppercase (style-properties s))))
+ "UC"
+ "")
+ (if (null? formatted-number)
+ "UN"
+ ""))
+ (when (and lbl? (not link-number?))
+ (printf "t:~a}{" (t-encode (vector-ref dest 1))))
+ (unless (null? formatted-number)
+ (when link-number? (printf "\\SectionNumberLink{t:~a}{" (t-encode (vector-ref dest 1))))
+ (render-content
+ (if dest
+ (if (list? number)
+ formatted-number
+ (begin (eprintf "Internal tag error: ~s -> ~s\n"
+ (link-element-tag e)
+ dest)
+ '("!!!")))
+ (list "???"))
+ part ri)
+ (when link-number? (printf "}"))
+ (printf "}{"))))
+ (let* ([es (cond
+ [(element? e) (element-style e)]
+ [(multiarg-element? e) (multiarg-element-style e)]
+ [else #f])]
+ [style-name (if (style? es)
+ (style-name es)
+ es)]
+ [style (and (style? es) es)]
+ [hyperref? (and (not part-label?)
+ (link-element? e)
+ (not (disable-hyperref))
+ (let-values ([(dest ext?) (resolve-get/ext? part ri (link-element-tag e))])
+ (and (not ext?) dest)))]
+ [check-render
+ (lambda ()
+ (when (render-element? e)
+ ((render-element-render e) this part ri)))]
+ [core-render (lambda (e tt?)
+ (cond
+ [(and (image-element? e)
+ (not (disable-images)))
+ (check-render)
+ (let ([fn (install-file
+ (select-suffix
+ (collects-relative->path
+ (image-element-path e))
+ (image-element-suffixes e)
+ '(".pdf" ".ps" ".png")))])
+ (printf "\\includegraphics[scale=~a]{~a}"
+ (image-element-scale e) fn))]
+ [(and (convertible? e)
+ (not (disable-images))
+ (let ([ftag (lambda (v suffix [scale 1]) (and v (list v suffix scale)))]
+ [xxlist (lambda (v) (and v (list v #f #f #f #f #f #f #f #f)))]
+ [xlist (lambda (v) (and v (append v (list 0 0 0 0))))])
+ (for/or ([req (in-list image-reqs)])
+ (case req
+ [(eps-bytes)
+ (or (ftag (convert e 'eps-bytes+bounds8) ".ps")
+ (ftag (xlist (convert e 'eps-bytes+bounds)) ".ps")
+ (ftag (xxlist (convert e 'eps-bytes)) ".ps"))]
+ [(pdf-bytes)
+ (or (ftag (convert e 'pdf-bytes+bounds8) ".pdf")
+ (ftag (xlist (convert e 'pdf-bytes+bounds)) ".pdf")
+ (ftag (xxlist (convert e 'pdf-bytes)) ".pdf"))]
+ [(png@2x-bytes)
+ (or (ftag (convert e 'png@2x-bytes+bounds8) ".png" 0.5)
+ (ftag (xxlist (convert e 'png@2x-bytes)) ".png" 0.5))]
+ [(png-bytes)
+ (or (ftag (convert e 'png-bytes+bounds8) ".png")
+ (ftag (xxlist (convert e 'png-bytes)) ".png"))]))))
+ => (lambda (bstr+info+suffix)
+ (check-render)
+ (let* ([bstr (list-ref (list-ref bstr+info+suffix 0) 0)]
+ [suffix (list-ref bstr+info+suffix 1)]
+ [scale (list-ref bstr+info+suffix 2)]
+ [height (list-ref (list-ref bstr+info+suffix 0) 2)]
+ [pad-left (or (list-ref (list-ref bstr+info+suffix 0) 5) 0)]
+ [pad-top (or (list-ref (list-ref bstr+info+suffix 0) 6) 0)]
+ [pad-right (or (list-ref (list-ref bstr+info+suffix 0) 7) 0)]
+ [pad-bottom (or (list-ref (list-ref bstr+info+suffix 0) 8) 0)]
+ [descent (and height
+ (- (+ (list-ref (list-ref bstr+info+suffix 0) 3)
+ (- (ceiling height) height))
+ pad-bottom))]
+ [width (let ([w (list-ref (list-ref bstr+info+suffix 0) 1)])
+ (and w (- w pad-left pad-right)))]
+ [fn (install-file (format "pict~a" suffix) bstr)])
+ (if descent
+ (printf "\\raisebox{-~abp}{\\makebox[~abp][l]{\\includegraphics[~atrim=~a ~a ~a ~a]{~a}}}"
+ descent
+ width
+ (if (= scale 1) "" (format "scale=~a," scale))
+ (/ pad-left scale) (/ pad-bottom scale) (/ pad-right scale) (/ pad-top scale)
+ fn)
+ (printf "\\includegraphics{~a}" fn))))]
+ [else
+ (parameterize ([rendering-tt (or tt? (rendering-tt))])
+ (super render-content e part ri))]))]
+ [wrap (lambda (e s tt?)
+ (when s (printf "\\~a{" s))
+ (core-render e tt?)
+ (when s (printf "}")))])
+ (define (finish tt?)
+ (cond
+ [(symbol? style-name)
+ (case style-name
+ [(emph) (wrap e "emph" tt?)]
+ [(italic) (wrap e "textit" tt?)]
+ [(bold) (wrap e "textbf" tt?)]
+ [(tt) (wrap e "Scribtexttt" #t)]
+ [(url) (wrap e "Snolinkurl" 'url)]
+ [(no-break) (wrap e "mbox" tt?)]
+ [(sf) (wrap e "textsf" #f)]
+ [(roman) (wrap e "textrm" #f)]
+ [(subscript) (wrap e "textsub" #f)]
+ [(superscript) (wrap e "textsuper" #f)]
+ [(smaller) (wrap e "Smaller" #f)]
+ [(larger) (wrap e "Larger" #f)]
+ [(hspace)
+ (check-render)
+ (let ([s (content->string e)])
+ (case (string-length s)
+ [(0) (void)]
+ [else
+ (printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
+ (regexp-replace* #rx"." s "x"))]))]
+ [(newline)
+ (check-render)
+ (unless (suppress-newline-content)
+ (printf "\\hspace*{\\fill}\\\\"))]
+ [else (error 'latex-render
+ "unrecognized style symbol: ~s" style)])]
+ [(string? style-name)
+ (let* ([v (if style (style-properties style) null)]
+ [tt? (cond
+ [(memq 'tt-chars v) #t]
+ [(memq 'exact-chars v) 'exact]
+ [else tt?])])
(cond
- [(target-url? v)
- (define target (let* ([s (let ([p (target-url-addr v)])
- (if (path? p)
- (path->string p)
- p))]
- [s (regexp-replace* #rx"\\\\" s "%5c")]
- [s (regexp-replace* #rx"{" s "%7b")]
- [s (regexp-replace* #rx"}" s "%7d")]
- [s (regexp-replace* #rx"%" s "\\\\%")])
- s))
+ [(multiarg-element? e)
+ (check-render)
+ (printf "\\~a" style-name)
+ (define maybe-optional-args
+ (findf command-optional? (if style (style-properties style) '())))
+ (when maybe-optional-args
+ (for ([i (in-list (command-optional-arguments maybe-optional-args))])
+ (printf "[~a]" i)))
+ (if (null? (multiarg-element-contents e))
+ (printf "{}")
+ (for ([i (in-list (multiarg-element-contents e))])
+ (printf "{")
+ (parameterize ([rendering-tt (or tt? (rendering-tt))])
+ (render-content i part ri))
+ (printf "}")))]
+ [else
+ (define maybe-optional
+ (findf command-optional? (if style (style-properties style) '())))
+ (if maybe-optional
+ (wrap e
+ (string-join #:before-first (format "~a[" style-name)
+ #:after-last "]"
+ (command-optional-arguments maybe-optional)
+ "][")
+ tt?)
+ (wrap e style-name tt?))]))]
+ [(and (not style-name)
+ style
+ (memq 'exact-chars (style-properties style)))
+ (wrap e style-name 'exact)]
+ [else
+ (core-render e tt?)]))
+ (when hyperref?
+ (printf "\\hyperref[t:~a]{"
+ (t-encode (vector-ref hyperref? 1))))
+ (let loop ([l (if style (style-properties style) null)] [tt? #f])
+ (if (null? l)
+ (if hyperref?
+ (parameterize ([disable-hyperref #t])
+ (finish tt?))
+ (finish tt?))
+ (let ([v (car l)])
(cond
- [(equal? target "#") (printf "{")]
- [(regexp-match? #rx"^[^#]*#[^#]*$" target)
- ;; work around a problem with `\href' as an
- ;; argument to other macros, such as `\marginpar':
- (let ([l (string-split target "#")])
- (printf "\\Shref{~a}{~a}{" (car l) (cadr l)))]
- [else
- ;; normal:
- (printf "\\href{~a}{" target)])
- (loop (cdr l) #t)
- (printf "}")]
- [(color-property? v)
- (printf "\\intext~acolor{~a}{"
- (if (string? (color-property-color v)) "" "rgb")
- (color->string (color-property-color v)))
- (loop (cdr l) tt?)
- (printf "}")]
- [(background-color-property? v)
- (printf "\\in~acolorbox{~a}{"
- (if (string? (background-color-property-color v)) "" "rgb")
- (color->string (background-color-property-color v)))
- (loop (cdr l) tt?)
- (printf "}")]
- [(command-extras? (car l))
- (loop (cdr l) tt?)
- (for ([l (in-list (command-extras-arguments (car l)))])
- (printf "{~a}" l))]
- [else (loop (cdr l) tt?)]))))
- (when hyperref?
- (printf "}"))))
- (when part-label?
- (printf "}"))
- (when (and (link-element? e)
- (show-link-page-numbers)
- (not (done-link-page-numbers)))
- (define (make-ref e)
- (string-append
- "t:"
- (t-encode
- (let ([v (resolve-get part ri (link-element-tag e))])
- (and v (vector-ref v 1))))))
- (cond
- [(multiple-page-references) ; for index
- => (lambda (l)
- (printf ", \\Smanypageref{~a}" ; using cleveref
- (string-join (map make-ref l) ",")))]
- [else
- (printf ", \\pageref{~a}" (make-ref e))]))
- null))
+ [(target-url? v)
+ (define target (let* ([s (let ([p (target-url-addr v)])
+ (if (path? p)
+ (path->string p)
+ p))]
+ [s (regexp-replace* #rx"\\\\" s "%5c")]
+ [s (regexp-replace* #rx"{" s "%7b")]
+ [s (regexp-replace* #rx"}" s "%7d")]
+ [s (regexp-replace* #rx"%" s "\\\\%")])
+ s))
+ (cond
+ [(equal? target "#") (printf "{")]
+ [(regexp-match? #rx"^[^#]*#[^#]*$" target)
+ ;; work around a problem with `\href' as an
+ ;; argument to other macros, such as `\marginpar':
+ (let ([l (string-split target "#")])
+ (printf "\\Shref{~a}{~a}{" (car l) (cadr l)))]
+ [else
+ ;; normal:
+ (printf "\\href{~a}{" target)])
+ (loop (cdr l) #t)
+ (printf "}")]
+ [(color-property? v)
+ (printf "\\intext~acolor{~a}{"
+ (if (string? (color-property-color v)) "" "rgb")
+ (color->string (color-property-color v)))
+ (loop (cdr l) tt?)
+ (printf "}")]
+ [(background-color-property? v)
+ (printf "\\in~acolorbox{~a}{"
+ (if (string? (background-color-property-color v)) "" "rgb")
+ (color->string (background-color-property-color v)))
+ (loop (cdr l) tt?)
+ (printf "}")]
+ [(command-extras? (car l))
+ (loop (cdr l) tt?)
+ (for ([l (in-list (command-extras-arguments (car l)))])
+ (printf "{~a}" l))]
+ [else (loop (cdr l) tt?)]))))
+ (when hyperref?
+ (printf "}")))
+ (when part-label?
+ (printf "}"))
+ (when (and (link-element? e)
+ (show-link-page-numbers)
+ (not (done-link-page-numbers)))
+ (define (make-ref e)
+ (string-append
+ "t:"
+ (t-encode
+ (let ([v (resolve-get part ri (link-element-tag e))])
+ (and v (vector-ref v 1))))))
+ (cond
+ [(multiple-page-references) ; for index
+ => (lambda (l)
+ (printf ", \\Smanypageref{~a}" ; using cleveref
+ (string-join (map make-ref l) ",")))]
+ [else
+ (printf ", \\pageref{~a}" (make-ref e))])))
+ null)))
(define/private (t-encode s)
(string-append*
diff --git a/scribble-lib/scriblib/autobib.rkt b/scribble-lib/scriblib/autobib.rkt
index ea1976269c..1472a6e11b 100644
--- a/scribble-lib/scriblib/autobib.rkt
+++ b/scribble-lib/scriblib/autobib.rkt
@@ -624,8 +624,8 @@
(define (stringify v)
(and v (content->string (contentify v))))
-;; wrap non-#f content as an element, for backward compatibility with
-;; the *-location functions' historical result type. Flattens c first, so
+;; wrap non-#f content as an element, since the *-location functions are
+;; documented to return element?, not generic content. Flattens c first, so
;; content that's merely empty (e.g. "") normalizes to #f like an omitted
;; argument does, rather than becoming a visibly-empty but non-#f element.
;; Only call this on results that aren't already elements.
@@ -742,11 +742,10 @@
#:accessed "January 2024"
#:note "A note"))
"Title. doi:10.1234/foo. A note")
- ;; journal-location, techrpt-location, and book-chapter-location are contracted to
- ;; always return an element when given #f for their required argument (i.e.
- ;; supplying no real information), via ensure-nontrivial-content; see
- ;; scribble-test/tests/scriblib/autobib.rkt for the check-exn versions of this
- ;; going through the exported, contracted bindings instead.
+ ;; journal-location, techrpt-location, and book-chapter-location always
+ ;; return an element: each has a genuinely required argument, and
+ ;; ensure-nontrivial-content raises rather than letting a trivial value
+ ;; (i.e. no real information) through silently.
;; proceedings-location, book-location, booklet-location, misc-location, and
;; manual-location may gracefully return #f when every argument is #f or
;; empty content -- but only for plain (undecorated) fields: an explicitly
diff --git a/scribble-lib/scriblib/bibtex.rkt b/scribble-lib/scriblib/bibtex.rkt
index d3ff07380e..3756c398b1 100644
--- a/scribble-lib/scriblib/bibtex.rkt
+++ b/scribble-lib/scriblib/bibtex.rkt
@@ -1034,7 +1034,7 @@ BIB
(check-not-false (string-contains? compat-tex "J.~of Things"))
(delete-file tex-path)
- ;; Required fields must still produce useful errors when absent.
+ ;; Required fields produce a clear error when absent.
;; Each fixture below supplies every other required field, so the
;; error is unambiguously about the one field under test.
(check-exn
@@ -1055,7 +1055,7 @@ BIB
"@inproceedings{x, author={A}, title={X}, year={2026}}"))
"x")))
- ;; Missing author, title, or year is now caught too.
+ ;; Author, title, and year are each independently required.
(check-exn
#rx"missing attribute author"
(λ ()
@@ -1157,8 +1157,8 @@ BIB
(check-not-exn
(λ () (generate-bib (bibtex-parse (open-input-string "@misc{x,}")) "x")))
- ;; online/webpage aren't standard BIBTEXing types, but we still require
- ;; title and url (just not author) as our own policy.
+ ;; online/webpage aren't standard BIBTEXing types, but title and url
+ ;; (just not author) are required here as our own policy.
(check-not-exn
(λ () (generate-bib (bibtex-parse (open-input-string "@online{x, title={X}, url={https://example.org}}")) "x")))
(check-exn
diff --git a/scribble-test/tests/scribble/docs/secref-styles.scrbl b/scribble-test/tests/scribble/docs/secref-styles.scrbl
new file mode 100644
index 0000000000..f2fbd527bb
--- /dev/null
+++ b/scribble-test/tests/scribble/docs/secref-styles.scrbl
@@ -0,0 +1,42 @@
+#lang scribble/base
+@(require scribble/core)
+
+@title[#:tag "top"]{Secref Style Modes}
+
+@section[#:tag "numbered"]{A Numbered Section}
+
+Body text for the numbered section.
+
+@section[#:style '(unnumbered) #:tag "unnumbered"]{An Unnumbered Section}
+
+Body text for the unnumbered section.
+
+Default: @secref["numbered" #:link-render-style (link-render-style 'default)].
+
+Number: @secref["numbered" #:link-render-style (link-render-style 'number)].
+
+Short: @secref["numbered" #:link-render-style (link-render-style 'short)].
+
+Number and title: @secref["numbered" #:link-render-style (link-render-style 'number-and-title)].
+
+Short, unnumbered: @secref["unnumbered" #:link-render-style (link-render-style 'short)].
+
+Number and title, unnumbered: @secref["unnumbered" #:link-render-style (link-render-style 'number-and-title)].
+
+A target with no numbering metadata at all (not a section):
+@(make-target-element #f (list "A Bare Target") '(part "bare-target")) is here.
+
+Number and title, no numbering metadata: @secref["bare-target" #:link-render-style (link-render-style 'number-and-title)].
+
+Colored short, to check the original link's style (e.g. color) survives:
+@(make-link-element
+ (make-style #f (list (link-render-style 'short) (make-color-property "red")))
+ null
+ (make-section-tag "numbered")).
+
+@section[#:style '(unnumbered) #:tag "empty"]{}
+
+Short, empty title (exercises the case where the fallback title is
+itself empty, which the self-contained LaTeX rendering must not
+mistake for another empty-content part-label link):
+@secref["empty" #:link-render-style (link-render-style 'short)].
diff --git a/scribble-test/tests/scribble/main.rkt b/scribble-test/tests/scribble/main.rkt
index 1656cb4f2b..46507c7397 100644
--- a/scribble-test/tests/scribble/main.rkt
+++ b/scribble-test/tests/scribble/main.rkt
@@ -2,7 +2,8 @@
(require tests/eli-tester
"reader.rkt" "text-collect.rkt" "text-lang.rkt" "text-wrap.rkt"
- "docs.rkt" "render.rkt" "xref.rkt" "markdown.rkt" "typst.rkt")
+ "docs.rkt" "render.rkt" "xref.rkt" "markdown.rkt" "typst.rkt"
+ "secref-styles.rkt")
(test do (reader-tests)
do (begin/collect-tests)
@@ -12,4 +13,5 @@
do (render-tests)
do (xref-tests)
do (markdown-tests)
- do (typst-tests))
+ do (typst-tests)
+ do (secref-styles-tests))
diff --git a/scribble-test/tests/scribble/secref-styles.rkt b/scribble-test/tests/scribble/secref-styles.rkt
new file mode 100644
index 0000000000..c3626cbb8a
--- /dev/null
+++ b/scribble-test/tests/scribble/secref-styles.rkt
@@ -0,0 +1,116 @@
+#lang racket/base
+
+;; Tests for the link-render-style modes ('default, 'number, 'short, and
+;; 'number-and-title; see scribble/core's link-element and
+;; link-render-style docs), across HTML and LaTeX output.
+;;
+;; Checks use the exact literal text each mode is expected to produce
+;; (via regexp-quote, to avoid hand-escaping mistakes), rather than loose
+;; substring matches, since this document's own section headings share
+;; words (and even the whole title) with what a secref renders -- a loose
+;; match on, say, the title text alone would pass even if the secref
+;; itself rendered nothing at all.
+
+(require racket/class
+ racket/file
+ racket/runtime-path
+ rackunit
+ scribble/base-render
+ (prefix-in html: scribble/html-render)
+ (prefix-in latex: scribble/latex-render))
+
+(define-runtime-path secref-styles-scrbl "docs/secref-styles.scrbl")
+(define work-dir (build-path (find-system-path 'temp-dir)
+ "scribble-secref-styles-tests"))
+
+(define (build-doc render% dest-file)
+ (define renderer (new render% [dest-dir work-dir]))
+ (define docs
+ (list (if (module-declared? `(submod ,secref-styles-scrbl doc) #t)
+ (dynamic-require `(submod ,secref-styles-scrbl doc) 'doc)
+ (dynamic-require secref-styles-scrbl 'doc))))
+ (define fns (list (build-path work-dir dest-file)))
+ (define fp (send renderer traverse docs fns))
+ (let ([docs (send renderer traversed-parts docs fp)])
+ (define info (send renderer collect docs fns fp))
+ (define r-info (send renderer resolve docs fns info))
+ (send renderer render docs fns r-info)
+ (void)))
+
+(define (has? out str)
+ (regexp-match? (regexp-quote str) out))
+
+(provide secref-styles-tests)
+(module+ main (secref-styles-tests))
+(module+ test (secref-styles-tests))
+
+(define (secref-styles-tests)
+ (when (or (file-exists? work-dir) (directory-exists? work-dir))
+ (delete-directory/files work-dir))
+ (dynamic-wind
+ (λ () (make-directory work-dir))
+ (λ ()
+ (check-not-exn
+ (λ () (build-doc (html:render-mixin render%) "secref-styles.html")))
+ (define html-out (file->string (build-path work-dir "secref-styles.html")))
+
+ ;; 'default: the title wrapped in an anchor tag -- distinguishing
+ ;; this from the identical text in the section's own (unwrapped)
+ ;; heading.
+ (check-true (regexp-match? #rx"]*>A Numbered Section" html-out))
+ ;; 'number: the word "section" (this document uses no #:uppercase
+ ;; style), followed by the hyperlinked number "1" and a closing
+ ;; anchor tag -- distinguishing this from the unrelated word
+ ;; "section" in this file's own prose, which is never followed by
+ ;; an anchor tag.
+ (check-true (regexp-match? #rx"section [^<]*]*>1" html-out))
+ ;; 'short: just the section number, as "§1", hyperlinked.
+ (check-true (has? html-out "§1"))
+ ;; 'short falls back to the plain title, still hyperlinked (as
+ ;; opposed to the section's own unwrapped heading), when unnumbered.
+ (check-true (regexp-match? #rx"]*>An Unnumbered Section" html-out))
+ ;; 'number-and-title: the number and the quoted title together.
+ (check-true (has? html-out "§1 “A Numbered Section”"))
+ ;; 'number-and-title falls back to just the quoted title (still
+ ;; distinguishable from the plain heading) when unnumbered.
+ (check-true (has? html-out "“An Unnumbered Section”"))
+ ;; A target with no numbering metadata at all (dest-number is #f,
+ ;; not just an empty list, e.g. for a bare target-element that
+ ;; isn't a section) should render as just the quoted title, like
+ ;; the unnumbered-section case above.
+ (check-true (has? html-out "“A Bare Target”"))
+
+ ;; This also exercises 'short on an unnumbered section with a
+ ;; genuinely empty title, which render-self-contained-secref must
+ ;; not mistake for another empty-content part-label link (that
+ ;; would re-enter the same method indefinitely). There isn't much
+ ;; else to meaningfully assert about a link with an empty title,
+ ;; so this check-not-exn is the test for it.
+ (check-not-exn
+ (λ () (build-doc (latex:render-mixin render%) "secref-styles.tex")))
+ (define tex-out (file->string (build-path work-dir "secref-styles.tex")))
+
+ ;; 'default and 'number depend on document-style .tex macros (see
+ ;; scribble.tex/manual-style.tex) that only expand into their final
+ ;; wording when actually compiled with a LaTeX toolchain, which this
+ ;; test doesn't do -- so only a smoke check (above) applies to them
+ ;; for LaTeX; 'short and 'number-and-title, by contrast, write their
+ ;; final literal text directly, so their exact output can be checked
+ ;; here without compiling.
+
+ ;; 'short: the \S command (escaped as {\S}) followed by the number.
+ (check-true (has? tex-out "{\\S}1"))
+ ;; 'number-and-title: the number, then the quoted title (curly
+ ;; quotes are escaped as {``}/{''}, per convert-to-latex).
+ (check-true (has? tex-out "{\\S}1 {``}A Numbered Section{''}"))
+ ;; 'number-and-title falls back to just the quoted title when
+ ;; unnumbered.
+ (check-true (has? tex-out "{``}An Unnumbered Section{''}"))
+ ;; Same no-numbering-metadata case as above, for LaTeX.
+ (check-true (has? tex-out "{``}A Bare Target{''}"))
+ ;; The self-contained 'short/'number-and-title path must preserve
+ ;; the original link's style (e.g. color), not just its content:
+ ;; \intextcolor{red}{...} should wrap the "{\S}1" content.
+ (check-true (has? tex-out "\\intextcolor{red}{{\\S}1}"))
+ (void))
+ (λ () (delete-directory/files work-dir))))