Added the ability to disambiguate between citations using autobib.
original commit: 6f1c6b7d92f9654f84dba446edd0df377ee262eb
This commit is contained in:
James Ian Johnson
Sam Tobin-Hochstadt
parent
c50afd054e
commit
403058dcf2
|
|
@ -5,12 +5,14 @@
|
|||
scribble/decode
|
||||
scribble/html-properties
|
||||
scribble/latex-properties
|
||||
(for-syntax syntax/parse
|
||||
racket/base)
|
||||
scheme/string
|
||||
setup/main-collects)
|
||||
|
||||
(provide define-cite
|
||||
make-bib in-bib (rename-out [auto-bib? bib?])
|
||||
proceedings-location journal-location book-location
|
||||
proceedings-location journal-location book-location
|
||||
techrpt-location dissertation-location
|
||||
author-name org-author-name authors other-authors editor)
|
||||
|
||||
|
|
@ -22,45 +24,60 @@
|
|||
(make-css-addition (abs "autobib.css"))
|
||||
(make-tex-addition (abs "autobib.tex")))))
|
||||
|
||||
(define bib-table-style (make-style "AutoBibliography" autobib-style-extras))
|
||||
(define bib-table-style (make-style "AutoBibliography" autobib-style-extras))
|
||||
(define bibentry-style (make-style "Autobibentry" autobib-style-extras))
|
||||
|
||||
|
||||
(define-struct auto-bib (author date entry-element key specific))
|
||||
(define-struct bib-group (ht))
|
||||
|
||||
(define-struct (author-element element) (names cite))
|
||||
(define-struct (other-author-element author-element) ())
|
||||
|
||||
(define (add-cite group bib-entry which with-specific?)
|
||||
|
||||
;; render the use of a citation.
|
||||
(define (add-cite group bib-entry which with-specific? with-disambiguation?)
|
||||
(let ([key (auto-bib-key bib-entry)])
|
||||
(hash-set! (bib-group-ht group) key bib-entry)
|
||||
(make-delayed-element
|
||||
(lambda (renderer part ri)
|
||||
(let ([s (resolve-get part ri `(,which ,key))])
|
||||
(list (make-link-element #f
|
||||
(list (or s "???")
|
||||
(if with-specific?
|
||||
(auto-bib-specific bib-entry)
|
||||
""))
|
||||
`(autobib ,(auto-bib-key bib-entry))))))
|
||||
;; (list which key) should be mapped to the bibliography element.
|
||||
(define s (resolve-get part ri `(,which ,key)))
|
||||
(define disambiguation
|
||||
(cond [(and with-disambiguation?
|
||||
(resolve-get part ri `(autobib-disambiguation ,key)))
|
||||
=>
|
||||
(λ (dis)
|
||||
(case dis
|
||||
[(unambiguous) '()]
|
||||
[else
|
||||
(list
|
||||
(make-link-element #f (list dis)
|
||||
`(autobib ,(auto-bib-key bib-entry))))]))]
|
||||
[else '()]))
|
||||
(cons (make-link-element #f
|
||||
(list (or s "???")
|
||||
(if with-specific?
|
||||
(auto-bib-specific bib-entry)
|
||||
""))
|
||||
`(autobib ,(auto-bib-key bib-entry)))
|
||||
disambiguation))
|
||||
(lambda () "(???)")
|
||||
(lambda () "(???)"))))
|
||||
|
||||
(define (add-inline-cite group bib-entries)
|
||||
(for ([i bib-entries])
|
||||
(for ([i bib-entries])
|
||||
(hash-set! (bib-group-ht group) (auto-bib-key i) i))
|
||||
(when (and (pair? (cdr bib-entries))
|
||||
(when (and (pair? (cdr bib-entries))
|
||||
(not (apply equal? (map (compose author-element-names auto-bib-author) bib-entries))))
|
||||
(error 'citet "citet must be used with identical authors, given ~a"
|
||||
(error 'citet "citet must be used with identical authors, given ~a"
|
||||
(map (compose author-element-names auto-bib-author) bib-entries)))
|
||||
(make-element
|
||||
(make-element
|
||||
#f
|
||||
(list (add-cite group (car bib-entries) 'autobib-author #f)
|
||||
(list (add-cite group (car bib-entries) 'autobib-author #f #f)
|
||||
'nbsp
|
||||
"("
|
||||
(let loop ([keys bib-entries])
|
||||
(if (null? (cdr keys))
|
||||
(add-cite group (car keys) 'autobib-date #t)
|
||||
(add-cite group (car keys) 'autobib-date #t #t)
|
||||
(make-element
|
||||
#f
|
||||
(list (loop (list (car keys)))
|
||||
|
|
@ -76,18 +93,18 @@
|
|||
(cons k (remove k ks))))))
|
||||
(make-element
|
||||
#f
|
||||
(append
|
||||
(append
|
||||
(list 'nbsp "(")
|
||||
(add-between
|
||||
(for/list ([k (if sort? (sort keys string-ci<?) keys)])
|
||||
(let ([v (hash-ref groups k)])
|
||||
(make-element
|
||||
#f
|
||||
(list*
|
||||
(add-cite group (car v) 'autobib-author #f)
|
||||
(make-element
|
||||
#f
|
||||
(list*
|
||||
(add-cite group (car v) 'autobib-author #f #f)
|
||||
" "
|
||||
(add-between
|
||||
(for/list ([b v]) (add-cite group b 'autobib-date #t))
|
||||
(for/list ([b v]) (add-cite group b 'autobib-date #t #t))
|
||||
", ")))))
|
||||
"; ")
|
||||
(list ")"))))
|
||||
|
|
@ -98,68 +115,99 @@
|
|||
(define (extract-bib-year b)
|
||||
(string->number (auto-bib-date b)))
|
||||
|
||||
;; 0 -> a, 1 -> b, etc.
|
||||
(define (default-disambiguation n)
|
||||
(when (>= n 26)
|
||||
(error 'default-disambiguation "Citations too ambiguous for default disambiguation scheme."))
|
||||
(make-element #f (list (format " ~a" (integer->char (+ 97 n))))))
|
||||
|
||||
(define (gen-bib tag group sec-title)
|
||||
(let* ([author/date<?
|
||||
(lambda (a b)
|
||||
(or
|
||||
(string-ci<? (extract-bib-key a) (extract-bib-key b))
|
||||
(and (string-ci=? (extract-bib-key a) (extract-bib-key b))
|
||||
(extract-bib-year a) (extract-bib-year b)
|
||||
(< (extract-bib-year a) (extract-bib-year b)))))]
|
||||
[bibs (sort (hash-map (bib-group-ht group)
|
||||
(lambda (k v) v))
|
||||
author/date<?)])
|
||||
(make-part
|
||||
#f
|
||||
`((part ,tag))
|
||||
(list sec-title)
|
||||
(make-style #f '(unnumbered))
|
||||
null
|
||||
(list
|
||||
(make-table
|
||||
bib-table-style
|
||||
(map (lambda (k)
|
||||
(list
|
||||
(make-paragraph
|
||||
plain
|
||||
(list
|
||||
(make-collect-element
|
||||
(define (gen-bib tag group sec-title maybe-disambiguator)
|
||||
(define disambiguator (or maybe-disambiguator default-disambiguation))
|
||||
(define (author/date<? a b)
|
||||
(or (string-ci<? (extract-bib-key a) (extract-bib-key b))
|
||||
(and (string-ci=? (extract-bib-key a) (extract-bib-key b))
|
||||
(extract-bib-year a)
|
||||
(extract-bib-year b)
|
||||
(< (extract-bib-year a) (extract-bib-year b)))))
|
||||
(define (ambiguous? a b)
|
||||
(and (string-ci=? (extract-bib-key a) (extract-bib-key b))
|
||||
(extract-bib-year a)
|
||||
(extract-bib-year b)
|
||||
(= (extract-bib-year a) (extract-bib-year b))))
|
||||
(define bibs (sort (hash-values (bib-group-ht group))
|
||||
author/date<?))
|
||||
(define disambiguated
|
||||
(let ()
|
||||
(define (bib->para bib [disambiguation #f])
|
||||
(define collect-target
|
||||
(list (make-target-element
|
||||
#f
|
||||
(list (make-target-element
|
||||
(list (auto-bib-entry-element bib))
|
||||
`(autobib ,(auto-bib-key bib)))))
|
||||
;; Communicate to scribble's resolve step.
|
||||
(define (collect ci)
|
||||
;; store the author
|
||||
(collect-put! ci
|
||||
`(autobib-author ,(auto-bib-key bib)) ;; (list which key)
|
||||
(make-element
|
||||
#f
|
||||
(list (auto-bib-entry-element k))
|
||||
`(autobib ,(auto-bib-key k))))
|
||||
(lambda (ci)
|
||||
(collect-put! ci
|
||||
`(autobib-author ,(auto-bib-key k))
|
||||
(make-element
|
||||
#f
|
||||
(list
|
||||
(author-element-cite (auto-bib-author k)))))
|
||||
(collect-put! ci
|
||||
`(autobib-date ,(auto-bib-key k))
|
||||
(make-element
|
||||
#f
|
||||
(list
|
||||
(auto-bib-date k))))))))))
|
||||
bibs)))
|
||||
null)))
|
||||
(list (author-element-cite (auto-bib-author bib)))))
|
||||
;; store the date
|
||||
(collect-put! ci
|
||||
`(autobib-date ,(auto-bib-key bib)) ;; (list which key)
|
||||
(make-element #f (list (auto-bib-date bib))))
|
||||
;; store how to disambiguate it from other like citations.
|
||||
(collect-put! ci
|
||||
`(autobib-disambiguation ,(auto-bib-key bib))
|
||||
(or disambiguation 'unambiguous)))
|
||||
(list
|
||||
(make-paragraph plain
|
||||
(list (make-collect-element #f collect-target collect)))))
|
||||
;; create the bibliography with disambiguations added.
|
||||
(define-values (last num-ambiguous rev-disambiguated*)
|
||||
(for/fold ([last #f] [num-ambiguous 0] [rev-disambiguated '()]) ([bib (in-list bibs)])
|
||||
(define ambiguous?? (and last (ambiguous? last bib)))
|
||||
(define num-ambiguous*
|
||||
(cond [ambiguous?? (add1 num-ambiguous)]
|
||||
[else 0]))
|
||||
;; the current entry is ambiguous with the last. Modify the last
|
||||
;; to have the first disambiguation.
|
||||
(define rev-disambiguated*
|
||||
(cond [(and ambiguous?? (= 0 num-ambiguous))
|
||||
(cons (bib->para last (disambiguator num-ambiguous))
|
||||
(cdr rev-disambiguated))]
|
||||
[else rev-disambiguated]))
|
||||
(define para*
|
||||
(bib->para bib (and ambiguous?? (disambiguator num-ambiguous*))))
|
||||
(values bib num-ambiguous* (cons para* rev-disambiguated*))))
|
||||
(reverse rev-disambiguated*)))
|
||||
(make-part #f
|
||||
`((part ,tag))
|
||||
(list sec-title)
|
||||
(make-style #f '(unnumbered))
|
||||
null
|
||||
(list (make-table bib-table-style disambiguated))
|
||||
null))
|
||||
|
||||
(define-syntax-rule (define-cite ~cite citet generate-bibliography)
|
||||
(begin
|
||||
(define group (make-bib-group (make-hasheq)))
|
||||
(define (~cite #:sort? [sort? #t] bib-entry . bib-entries)
|
||||
(add-cites group (cons bib-entry bib-entries) sort?))
|
||||
(define (citet bib-entry . bib-entries)
|
||||
(add-inline-cite group (cons bib-entry bib-entries)))
|
||||
(define (generate-bibliography #:tag [tag "doc-bibliography"] #:sec-title [sec-title "Bibliography"])
|
||||
(gen-bib tag group sec-title))))
|
||||
(define-syntax (define-cite stx)
|
||||
(syntax-parse stx
|
||||
[(_ cite* citet generate-bibliography
|
||||
(~optional (~seq #:disambiguate fn)
|
||||
#:defaults ([fn #'#f])))
|
||||
(syntax/loc stx
|
||||
(begin
|
||||
(define group (make-bib-group (make-hasheq)))
|
||||
(define (cite* #:sort? [sort? #t] bib-entry . bib-entries)
|
||||
(add-cites group (cons bib-entry bib-entries) sort?))
|
||||
(define (citet bib-entry . bib-entries)
|
||||
(add-inline-cite group (cons bib-entry bib-entries)))
|
||||
(define (generate-bibliography #:tag [tag "doc-bibliography"] #:sec-title [sec-title "Bibliography"])
|
||||
(gen-bib tag group sec-title fn))))]))
|
||||
|
||||
(define (ends-in-punc? e)
|
||||
(regexp-match? #rx"[.!?,]$" (content->string e)))
|
||||
|
||||
(define (make-bib #:title title
|
||||
(define (make-bib #:title title
|
||||
#:author [author #f]
|
||||
#:is-book? [is-book? #f]
|
||||
#:location [location #f]
|
||||
|
|
@ -169,28 +217,28 @@
|
|||
[(not author) #f]
|
||||
[(author-element? author) author]
|
||||
[else (parse-author author)])]
|
||||
[elem (make-element
|
||||
bibentry-style
|
||||
(append
|
||||
(if author
|
||||
`(,author
|
||||
,@(if (ends-in-punc? author)
|
||||
'(" ")
|
||||
'(". ")))
|
||||
null)
|
||||
;; (if is-book? null '(ldquo))
|
||||
(if is-book?
|
||||
(list (italic title))
|
||||
(decode-content (list title)))
|
||||
(if (ends-in-punc? title)
|
||||
null
|
||||
'("."))
|
||||
;; (if is-book? null '(rdquo))
|
||||
(if location
|
||||
`(" " ,@(decode-content (list location)) ,(if date "," "."))
|
||||
null)
|
||||
(if date `(" " ,@(decode-content (list (to-string date))) ".") null)
|
||||
(if url `(" " ,(link url (make-element 'url (list url)))) null)))])
|
||||
[content
|
||||
(append
|
||||
(if author
|
||||
`(,author
|
||||
,@(if (ends-in-punc? author)
|
||||
'(" ")
|
||||
'(". ")))
|
||||
null)
|
||||
;; (if is-book? null '(ldquo))
|
||||
(if is-book?
|
||||
(list (italic title))
|
||||
(decode-content (list title)))
|
||||
(if (ends-in-punc? title)
|
||||
null
|
||||
'("."))
|
||||
;; (if is-book? null '(rdquo))
|
||||
(if location
|
||||
`(" " ,@(decode-content (list location)) ,(if date "," "."))
|
||||
null)
|
||||
(if date `(" " ,@(decode-content (list (to-string date))) ".") null)
|
||||
(if url `(" " ,(link url (make-element 'url (list url)))) null))]
|
||||
[elem (make-element bibentry-style content)])
|
||||
(make-auto-bib
|
||||
(or author (org-author-name title))
|
||||
(to-string date)
|
||||
|
|
@ -204,23 +252,22 @@
|
|||
(auto-bib-date bib)
|
||||
(auto-bib-entry-element bib)
|
||||
(auto-bib-key bib)
|
||||
;; "where" is the only specific part of auto-bib elements currently.
|
||||
(string-append (auto-bib-specific bib) where)))
|
||||
|
||||
(define (parse-author a)
|
||||
(if (author-element? a)
|
||||
a
|
||||
(let* ([s (content->string a)]
|
||||
[m (regexp-match #px"^(.*) (([\\-]|\\p{L})+)$" s)])
|
||||
(make-author-element
|
||||
#f
|
||||
(list a)
|
||||
(if m
|
||||
(string-append (caddr m) " " (cadr m))
|
||||
s)
|
||||
(if m
|
||||
(caddr m)
|
||||
s)))))
|
||||
|
||||
(cond [(author-element? a) a]
|
||||
[else
|
||||
(define s (content->string a)) ;; plain text rendering
|
||||
(define m (regexp-match #px"^(.*) (([\\-]|\\p{L})+)$" s))
|
||||
(define names
|
||||
(cond [m (string-append (caddr m) " " (cadr m))]
|
||||
[else s]))
|
||||
(define cite
|
||||
(cond [m (caddr m)]
|
||||
[else s]))
|
||||
(make-author-element #f (list a) names cite)]))
|
||||
|
||||
(define (proceedings-location
|
||||
location
|
||||
#:pages [pages #f]
|
||||
|
|
@ -308,35 +355,39 @@
|
|||
"al."
|
||||
"al."))
|
||||
|
||||
(define (authors name . names)
|
||||
(let ([names (map parse-author (cons name names))])
|
||||
(make-author-element
|
||||
(define (authors name . names*)
|
||||
(define names (map parse-author (cons name names*)))
|
||||
(define slash-names (string-join (map author-element-names names) " / "))
|
||||
(define cite
|
||||
(case (length names)
|
||||
[(1) (author-element-cite (car names))]
|
||||
[(2) (if (other-author-element? (cadr names))
|
||||
(format "~a et al." (author-element-cite (car names)))
|
||||
(format "~a and ~a"
|
||||
(author-element-cite (car names))
|
||||
(author-element-cite (cadr names))))]
|
||||
[else (format "~a et al." (author-element-cite (car names)))]))
|
||||
(make-author-element
|
||||
#f
|
||||
(let loop ([names names] [prefix 0])
|
||||
(if (null? (cdr names))
|
||||
(case prefix
|
||||
[(0) (list (car names))]
|
||||
[(1) (if (other-author-element? (car names))
|
||||
(list " et al.")
|
||||
(list " and " (car names)))]
|
||||
[else (if (other-author-element? (car names))
|
||||
(list ", et al.")
|
||||
(list ", and " (car names)))])
|
||||
(case prefix
|
||||
[(0) (list* (car names)
|
||||
(loop (cdr names) (add1 prefix)))]
|
||||
[else (list* ", "
|
||||
(car names)
|
||||
(loop (cdr names) (add1 prefix)))])))
|
||||
(string-join (map author-element-names names) " / ")
|
||||
(case (length names)
|
||||
[(1) (author-element-cite (car names))]
|
||||
[(2) (if (other-author-element? (cadr names))
|
||||
(format "~a et al." (author-element-cite (car names)))
|
||||
(format "~a and ~a"
|
||||
(author-element-cite (car names))
|
||||
(author-element-cite (cadr names))))]
|
||||
[else (format "~a et al." (author-element-cite (car names)))]))))
|
||||
(cond [(null? (cdr names))
|
||||
(case prefix
|
||||
[(0) names]
|
||||
[(1) (if (other-author-element? (car names))
|
||||
(list " et al.")
|
||||
(list " and " (car names)))]
|
||||
[else (if (other-author-element? (car names))
|
||||
(list ", et al.")
|
||||
(list ", and " (car names)))])]
|
||||
[else
|
||||
(case prefix
|
||||
[(0) (list* (car names)
|
||||
(loop (cdr names) (add1 prefix)))]
|
||||
[else (list* ", "
|
||||
(car names)
|
||||
(loop (cdr names) (add1 prefix)))])]))
|
||||
slash-names
|
||||
cite))
|
||||
|
||||
(define (editor name)
|
||||
(let ([name (parse-author name)])
|
||||
|
|
|
|||
|
|
@ -9,11 +9,16 @@
|
|||
@defmodule[scriblib/autobib]
|
||||
|
||||
|
||||
@defform[(define-cite ~cite-id citet-id generate-bibliography-id)]{
|
||||
@defform[(define-cite ~cite-id citet-id generate-bibliography-id [#:disambiguate disambiguator])]{
|
||||
|
||||
Binds @racket[~cite-id], @racket[citet-id], and
|
||||
@racket[generate-bibliography-id], which share state to accumulate and
|
||||
render citations.
|
||||
@racket[generate-bibliography-id], which share state to accumulate and render
|
||||
citations. If two citations' references would render the same but are
|
||||
different, the optionally provided disambiguation function is used to add an
|
||||
extra element after the date. The default disambiguator will add "a", "b", etc
|
||||
until "z". Anything more ambiguous will throw an error. It has the contract
|
||||
|
||||
@racketblock[(-> exact-nonnegative-integer? element?)]
|
||||
|
||||
The function bound to @racket[~cite-id] produces a citation referring
|
||||
to one or more bibliography entries with a preceding non-breaking
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user