commit 5f29095f021c2d2fcfdd098a83691a2f4b162634
parent 9f799cd86ee155f8a68ca12df0680abc439744a5
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 18 Dec 2017 11:07:02 -0700
scribble/book-index: more book-like index style for Latex/PDF
Merge index entries that have the same key and use cleveref to
render the page-number sequence.
Diffstat:
9 files changed, 171 insertions(+), 9 deletions(-)
diff --git a/scribble-doc/scribblings/scribble/core.scrbl b/scribble-doc/scribblings/scribble/core.scrbl
@@ -520,6 +520,14 @@ The recognized @tech{style properties} are as follows:
section. See also @racket[link-element] and
@racket[current-link-render-style].}
+ @item{@racket['enable-index-merge] --- On an index parts or one of
+ its enclosing parts for Latex output, causes index entries to
+ be merged when they have the same content, with multiple
+ references for the same entry combined with @ltx{Smanypageref}.
+ The @ltx{Smanypageref} Latex macro must be redefined to accept
+ multiple @litchar{,}-separated labels and generate a suitable set of
+ references. See also @racketmodname[scriblib/book-index].}
+
]
The @racket[to-collect] field contains @techlink{content} that is
diff --git a/scribble-doc/scriblib/scribblings/book-index.scrbl b/scribble-doc/scriblib/scribblings/book-index.scrbl
@@ -0,0 +1,35 @@
+#lang scribble/manual
+@(require (for-label scribble/core
+ racket/base
+ scriblib/book-index))
+
+@title[#:tag "book-index"]{Book-Style Indexing}
+
+@defmodule[scriblib/book-index]{Provides a list of style properties to
+attach to a Scribble document that contains an index part, making the
+index more suitable for a traditional rendering on paper. The style
+properties cause index entries to be merged when they have the same
+content, with (potentially) multiple page numbers attached to the
+merged entry.}
+
+@defthing[book-index-style-properties list?]{
+
+Combine these style properties with others for the style of a part
+(typically specified in @racket[title]) for a document that contains
+an index. The style properties enable index merging and select an
+implementation based on the @tt{cleveref} Latex package.
+
+Example:
+
+@codeblock[#:keep-lang-line? #t]|{
+#lang scribble/base
+@(require scriblib/book-index
+ (only-in scribble/core make-style))
+
+@title[#:style (make-style #f book-index-style-properties)]{Demo}
+
+This paragraph is about @as-index{examples}.
+
+This paragraph is about @as-index{examples}, too.
+
+@index-section[]}|}
diff --git a/scribble-doc/scriblib/scribblings/scriblib.scrbl b/scribble-doc/scriblib/scribblings/scriblib.scrbl
@@ -10,3 +10,4 @@
@include-section["bibtex.scrbl"]
@include-section["footnote.scrbl"]
@include-section["render-cond.scrbl"]
+@include-section["book-index.scrbl"]
diff --git a/scribble-lib/scribble/latex-render.rkt b/scribble-lib/scribble/latex-render.rkt
@@ -2,6 +2,7 @@
(require "core.rkt"
"latex-properties.rkt"
"private/render-utils.rkt"
+ "private/latex-index.rkt"
racket/class
racket/runtime-path
racket/port
@@ -18,6 +19,7 @@
(define rendering-tt (make-parameter #f))
(define show-link-page-numbers (make-parameter #f))
(define done-link-page-numbers (make-parameter #f))
+(define multiple-page-references (make-parameter #f))
(define disable-images (make-parameter #f))
(define escape-brackets (make-parameter #f))
(define suppress-newline-content (make-parameter #f))
@@ -587,10 +589,19 @@
(when (and (link-element? e)
(show-link-page-numbers)
(not (done-link-page-numbers)))
- (printf ", \\pageref{t:~a}"
- (t-encode
- (let ([v (resolve-get part ri (link-element-tag e))])
- (and v (vector-ref v 1))))))
+ (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)
@@ -626,6 +637,11 @@
(let* ([s-name (style-name (table-style t))]
[boxed? (eq? 'boxed s-name)]
[index? (eq? 'index s-name)]
+ [merge-index? (let loop ([part part])
+ (or (memq 'enable-index-merge (style-properties (part-style part)))
+ (let* ([ci (part-collected-info part ri)]
+ [p (and ci (collected-info-parent ci))])
+ (and p (loop p)))))]
[tableform
(cond [index? "list"]
[(eq? 'block s-name) "tabular"]
@@ -758,6 +774,17 @@
(let ([flows (car blockss)]
[cell-styles (car cell-styless)])
(unless index? (add-clines prev-styles cell-styles))
+ (define group-size
+ (cond
+ [merge-index?
+ ;; Merge entries that have the same text & style
+ (let loop ([blockss (cdr blockss)] [group-size 1])
+ (cond
+ [(null? blockss) group-size]
+ [(same-index-entry? flows (car blockss))
+ (loop (cdr blockss) (add1 group-size))]
+ [else group-size]))]
+ [else 1]))
(let loop ([flows flows]
[cell-styles cell-styles]
[all-left-line?s all-left-line?s]
@@ -769,7 +796,10 @@
(cond
[index?
(printf "\n\\item ")
- (render-cell 1)
+ (parameterize ([multiple-page-references
+ (and (group-size . > . 1)
+ (extract-index-link-targets (take blockss group-size)))])
+ (render-cell 1))
#f]
[(eq? 'cont (car flows))
#f]
@@ -798,17 +828,18 @@
(cdr cell-styles)
(cdr all-left-line?s)
right-line?))))
+ (define rest-blockss (list-tail blockss group-size))
(unless (or index?
- (and (null? (cdr blockss))
+ (and (null? rest-blockss)
(not (for/or ([cell-style (in-list cell-styles)])
(or (memq 'bottom-border (style-properties cell-style))
(memq 'border (style-properties cell-style)))))))
(printf " \\\\\n"))
(cond
- [(null? (cdr blockss))
+ [(null? rest-blockss)
(unless index? (add-clines cell-styles #f))]
[else
- (loop (cdr blockss) (cdr cell-styless) cell-styles)])))
+ (loop rest-blockss (list-tail cell-styless group-size) cell-styles)])))
(unless inline?
(printf "\\end{~a}~a"
tableform
diff --git a/scribble-lib/scribble/private/latex-index.rkt b/scribble-lib/scribble/private/latex-index.rkt
@@ -0,0 +1,62 @@
+#lang racket/base
+(require "../core.rkt"
+ "../html-properties.rkt")
+
+(provide same-index-entry?
+ extract-index-link-targets)
+
+(define (same-index-entry? a-blocks b-blocks)
+ (and (= (length a-blocks) (length b-blocks))
+ ;; We expect an index entry to have a single paragraph, but
+ ;; allow a list:
+ (for/and ([a (in-list a-blocks)]
+ [b (in-list b-blocks)])
+ (and (paragraph? a)
+ (paragraph? b)
+ ;; Compare paragraph content, paying attention to style,
+ ;; but not paying attention to link targets:
+ (let loop ([a (paragraph-content a)]
+ [b (paragraph-content b)])
+ (cond
+ [(equal? a b) #t]
+ [(alpha-anchor-content a) => (lambda (a) (loop a b))]
+ [(alpha-anchor-content b) => (lambda (b) (loop a b))]
+ [(and (pair? a) (pair? b))
+ (and (loop (car a) (car b))
+ (loop (cdr a) (cdr b)))]
+ [(and (element? a)
+ (element? b))
+ (and (equal? (element-content a)
+ (element-content b))
+ (equal? (element-style a)
+ (element-style b)))]
+ [else #f]))))))
+
+(define (alpha-anchor-content e)
+ (and (element? e)
+ (let ([s (element-style e)])
+ (and s
+ (style? s)
+ (not (style-name s))
+ (= 1 (length (style-properties s)))
+ (url-anchor? (car (style-properties s)))))
+ (let ([c (element-content e)])
+ (cond
+ [(and (pair? c) (null? (cdr c))) (car c)]
+ [else c]))))
+
+(define (extract-index-link-targets blockss)
+ (apply
+ append
+ (for*/list ([blocks (in-list blockss)]
+ [b (in-list blocks)])
+ (cond
+ [(paragraph? b)
+ (let content-loop ([c (paragraph-content b)])
+ (cond
+ [(null? c) null]
+ [(pair? c) (append (content-loop (car c))
+ (content-loop (cdr c)))]
+ [(link-element? c) (list c)]
+ [else null]))]
+ [else null]))))
diff --git a/scribble-lib/scribble/scribble-load.tex b/scribble-lib/scribble/scribble-load.tex
@@ -15,4 +15,3 @@
\newcommand{\doHypersetup}{\hypersetup{bookmarks=true,bookmarksopen=true,bookmarksnumbered=true}}
\newcommand{\packageTocstyle}{\IfFileExists{tocstyle.sty}{\usepackage{tocstyle}\usetocstyle{standard}}{}}
\newcommand{\packageCJK}{\IfFileExists{CJK.sty}{\usepackage{CJK}}{}}
-
diff --git a/scribble-lib/scribble/scribble.tex b/scribble-lib/scribble/scribble.tex
@@ -14,6 +14,7 @@
\packageTocstyle
\packageCJK
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Configuration that is especially meant to be overridden:
@@ -68,6 +69,11 @@
\newcommand{\SectionNumberLink}[2]{\hyperref[#1]{#2}}
+% Enabled with a 'enable-index-merge part style property. This default
+% implementation isn't good enough, because the argument is a
+% comma-separated sequence of labels:
+\newcommand{\Smanypageref}[1]{\pageref{#1}}
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Fonts
diff --git a/scribble-lib/scriblib/book-index.rkt b/scribble-lib/scriblib/book-index.rkt
@@ -0,0 +1,12 @@
+#lang racket/base
+(require racket/runtime-path
+ scribble/latex-properties)
+
+(provide book-index-style-properties)
+
+(define-runtime-path book-index.tex "book-index.tex")
+
+(define book-index-style-properties
+ (list
+ (tex-addition book-index.tex)
+ 'enable-index-merge))
diff --git a/scribble-lib/scriblib/book-index.tex b/scribble-lib/scriblib/book-index.tex
@@ -0,0 +1,8 @@
+\usepackage{cleveref}
+
+\newcommand{\crefrangeconjunction}{, }
+\newcommand{\crefpairconjunction}{, }
+\newcommand{\crefmiddleconjunction}{, }
+\newcommand{\creflastconjunction}{, }
+
+\renewcommand{\Smanypageref}[1]{\labelcpageref{#1}}
