latex-index.rkt (2239B)
1 #lang racket/base 2 (require "../core.rkt" 3 "../html-properties.rkt") 4 5 (provide same-index-entry? 6 extract-index-link-targets) 7 8 (define (same-index-entry? a-blocks b-blocks) 9 (and (= (length a-blocks) (length b-blocks)) 10 ;; We expect an index entry to have a single paragraph, but 11 ;; allow a list: 12 (for/and ([a (in-list a-blocks)] 13 [b (in-list b-blocks)]) 14 (and (paragraph? a) 15 (paragraph? b) 16 ;; Compare paragraph content, paying attention to style, 17 ;; but not paying attention to link targets: 18 (let loop ([a (paragraph-content a)] 19 [b (paragraph-content b)]) 20 (cond 21 [(equal? a b) #t] 22 [(alpha-anchor-content a) => (lambda (a) (loop a b))] 23 [(alpha-anchor-content b) => (lambda (b) (loop a b))] 24 [(and (pair? a) (pair? b)) 25 (and (loop (car a) (car b)) 26 (loop (cdr a) (cdr b)))] 27 [(and (element? a) 28 (element? b)) 29 (and (equal? (element-content a) 30 (element-content b)) 31 (equal? (element-style a) 32 (element-style b)))] 33 [else #f])))))) 34 35 (define (alpha-anchor-content e) 36 (and (element? e) 37 (let ([s (element-style e)]) 38 (and s 39 (style? s) 40 (not (style-name s)) 41 (= 1 (length (style-properties s))) 42 (url-anchor? (car (style-properties s))))) 43 (let ([c (element-content e)]) 44 (cond 45 [(and (pair? c) (null? (cdr c))) (car c)] 46 [else c])))) 47 48 (define (extract-index-link-targets blockss) 49 (apply 50 append 51 (for*/list ([blocks (in-list blockss)] 52 [b (in-list blocks)]) 53 (cond 54 [(paragraph? b) 55 (let content-loop ([c (paragraph-content b)]) 56 (cond 57 [(null? c) null] 58 [(pair? c) (append (content-loop (car c)) 59 (content-loop (cdr c)))] 60 [(link-element? c) (list c)] 61 [else null]))] 62 [else null]))))