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.

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

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[]}|}

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"]

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

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]))))

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}}{}}
-

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
 

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))

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}}