suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added the ability to disambiguate between citations using autobib.

Browse Source
This commit is contained in:
James Ian Johnson 2012-03-07 12:31:55 -05:00 committed by Sam Tobin-Hochstadt
parent ac99b732fa
commit 6f1c6b7d92
2 changed files with 200 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

229
collects/scriblib/autobib.rkt
View File

@ -5,6 +5,8 @@
scribble/decode scribble/decode
scribble/html-properties scribble/html-properties
scribble/latex-properties scribble/latex-properties
(for-syntax syntax/parse
racket/base)
scheme/string scheme/string
setup/main-collects) setup/main-collects)
@ -31,18 +33,33 @@
(define-struct (author-element element) (names cite)) (define-struct (author-element element) (names cite))
(define-struct (other-author-element author-element) ()) (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)]) (let ([key (auto-bib-key bib-entry)])
(hash-set! (bib-group-ht group) key bib-entry) (hash-set! (bib-group-ht group) key bib-entry)
(make-delayed-element (make-delayed-element
(lambda (renderer part ri) (lambda (renderer part ri)
(let ([s (resolve-get part ri `(,which ,key))]) ;; (list which key) should be mapped to the bibliography element.
(list (make-link-element #f (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 "???") (list (or s "???")
(if with-specific? (if with-specific?
(auto-bib-specific bib-entry) (auto-bib-specific bib-entry)
"")) ""))
`(autobib ,(auto-bib-key bib-entry)))))) `(autobib ,(auto-bib-key bib-entry)))
disambiguation))
(lambda () "(???)") (lambda () "(???)")
(lambda () "(???)")))) (lambda () "(???)"))))
@ -55,12 +72,12 @@
(map (compose author-element-names auto-bib-author) bib-entries))) (map (compose author-element-names auto-bib-author) bib-entries)))
(make-element (make-element
#f #f
(list (add-cite group (car bib-entries) 'autobib-author #f) (list (add-cite group (car bib-entries) 'autobib-author #f #f)
'nbsp 'nbsp
"(" "("
(let loop ([keys bib-entries]) (let loop ([keys bib-entries])
(if (null? (cdr keys)) (if (null? (cdr keys))
(add-cite group (car keys) 'autobib-date #t) (add-cite group (car keys) 'autobib-date #t #t)
(make-element (make-element
#f #f
(list (loop (list (car keys))) (list (loop (list (car keys)))
@ -84,10 +101,10 @@
(make-element (make-element
#f #f
(list* (list*
(add-cite group (car v) 'autobib-author #f) (add-cite group (car v) 'autobib-author #f #f)
" " " "
(add-between (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 ")")))) (list ")"))))
@ -98,63 +115,94 @@
(define (extract-bib-year b) (define (extract-bib-year b)
(string->number (auto-bib-date 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) (define (gen-bib tag group sec-title maybe-disambiguator)
(let* ([author/date<? (define disambiguator (or maybe-disambiguator default-disambiguation))
(lambda (a b) (define (author/date<? a b)
(or (or (string-ci<? (extract-bib-key a) (extract-bib-key b))
(string-ci<? (extract-bib-key a) (extract-bib-key b))
(and (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 a) (extract-bib-year b)))))] (extract-bib-year b)
[bibs (sort (hash-map (bib-group-ht group) (< (extract-bib-year a) (extract-bib-year b)))))
(lambda (k v) v)) (define (ambiguous? a b)
author/date<?)]) (and (string-ci=? (extract-bib-key a) (extract-bib-key b))
(make-part (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 #f
(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 (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)) `((part ,tag))
(list sec-title) (list sec-title)
(make-style #f '(unnumbered)) (make-style #f '(unnumbered))
null null
(list (list (make-table bib-table-style disambiguated))
(make-table null))
bib-table-style
(map (lambda (k)
(list
(make-paragraph
plain
(list
(make-collect-element
#f
(list (make-target-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)))
(define-syntax-rule (define-cite ~cite citet generate-bibliography) (define-syntax (define-cite stx)
(syntax-parse stx
[(_ cite* citet generate-bibliography
(~optional (~seq #:disambiguate fn)
#:defaults ([fn #'#f])))
(syntax/loc stx
(begin (begin
(define group (make-bib-group (make-hasheq))) (define group (make-bib-group (make-hasheq)))
(define (~cite #:sort? [sort? #t] bib-entry . bib-entries) (define (cite* #:sort? [sort? #t] bib-entry . bib-entries)
(add-cites group (cons bib-entry bib-entries) sort?)) (add-cites group (cons bib-entry bib-entries) sort?))
(define (citet bib-entry . bib-entries) (define (citet bib-entry . bib-entries)
(add-inline-cite group (cons 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"]) (define (generate-bibliography #:tag [tag "doc-bibliography"] #:sec-title [sec-title "Bibliography"])
(gen-bib tag group sec-title)))) (gen-bib tag group sec-title fn))))]))
(define (ends-in-punc? e) (define (ends-in-punc? e)
(regexp-match? #rx"[.!?,]$" (content->string e))) (regexp-match? #rx"[.!?,]$" (content->string e)))
@ -169,8 +217,7 @@
[(not author) #f] [(not author) #f]
[(author-element? author) author] [(author-element? author) author]
[else (parse-author author)])] [else (parse-author author)])]
[elem (make-element [content
bibentry-style
(append (append
(if author (if author
`(,author `(,author
@ -190,7 +237,8 @@
`(" " ,@(decode-content (list location)) ,(if date "," ".")) `(" " ,@(decode-content (list location)) ,(if date "," "."))
null) null)
(if date `(" " ,@(decode-content (list (to-string date))) ".") null) (if date `(" " ,@(decode-content (list (to-string date))) ".") null)
(if url `(" " ,(link url (make-element 'url (list url)))) null)))]) (if url `(" " ,(link url (make-element 'url (list url)))) null))]
[elem (make-element bibentry-style content)])
(make-auto-bib (make-auto-bib
(or author (org-author-name title)) (or author (org-author-name title))
(to-string date) (to-string date)
@ -204,22 +252,21 @@
(auto-bib-date bib) (auto-bib-date bib)
(auto-bib-entry-element bib) (auto-bib-entry-element bib)
(auto-bib-key bib) (auto-bib-key bib)
;; "where" is the only specific part of auto-bib elements currently.
(string-append (auto-bib-specific bib) where))) (string-append (auto-bib-specific bib) where)))
(define (parse-author a) (define (parse-author a)
(if (author-element? a) (cond [(author-element? a) a]
a [else
(let* ([s (content->string a)] (define s (content->string a)) ;; plain text rendering
[m (regexp-match #px"^(.*) (([\\-]|\\p{L})+)$" s)]) (define m (regexp-match #px"^(.*) (([\\-]|\\p{L})+)$" s))
(make-author-element (define names
#f (cond [m (string-append (caddr m) " " (cadr m))]
(list a) [else s]))
(if m (define cite
(string-append (caddr m) " " (cadr m)) (cond [m (caddr m)]
s) [else s]))
(if m (make-author-element #f (list a) names cite)]))
(caddr m)
s)))))
(define (proceedings-location (define (proceedings-location
location location
@ -308,27 +355,10 @@
"al." "al."
"al.")) "al."))
(define (authors name . names) (define (authors name . names*)
(let ([names (map parse-author (cons name names))]) (define names (map parse-author (cons name names*)))
(make-author-element (define slash-names (string-join (map author-element-names names) " / "))
#f (define cite
(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) (case (length names)
[(1) (author-element-cite (car names))] [(1) (author-element-cite (car names))]
[(2) (if (other-author-element? (cadr names)) [(2) (if (other-author-element? (cadr names))
@ -336,7 +366,28 @@
(format "~a and ~a" (format "~a and ~a"
(author-element-cite (car names)) (author-element-cite (car names))
(author-element-cite (cadr names))))] (author-element-cite (cadr names))))]
[else (format "~a et al." (author-element-cite (car names)))])))) [else (format "~a et al." (author-element-cite (car names)))]))
(make-author-element
#f
(let loop ([names names] [prefix 0])
(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) (define (editor name)
(let ([name (parse-author name)]) (let ([name (parse-author name)])

11
collects/scriblib/scribblings/autobib.scrbl
View File

@ -9,11 +9,16 @@
@defmodule[scriblib/autobib] @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 Binds @racket[~cite-id], @racket[citet-id], and
@racket[generate-bibliography-id], which share state to accumulate and @racket[generate-bibliography-id], which share state to accumulate and render
render citations. 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 The function bound to @racket[~cite-id] produces a citation referring
to one or more bibliography entries with a preceding non-breaking to one or more bibliography entries with a preceding non-breaking