suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Added the ability to disambiguate between citations using autobib.

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

305
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)))
(list (or s "???") (define disambiguation
(if with-specific? (cond [(and with-disambiguation?
(auto-bib-specific bib-entry) (resolve-get part ri `(autobib-disambiguation ,key)))
"")) =>
`(autobib ,(auto-bib-key bib-entry)))))) (λ (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 () "(???)")
(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 a) (extract-bib-year b) (extract-bib-year 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) (define (ambiguous? a b)
(lambda (k v) v)) (and (string-ci=? (extract-bib-key a) (extract-bib-key b))
author/date<?)]) (extract-bib-year a)
(make-part (extract-bib-year b)
#f (= (extract-bib-year a) (extract-bib-year b))))
`((part ,tag)) (define bibs (sort (hash-values (bib-group-ht group))
(list sec-title) author/date<?))
(make-style #f '(unnumbered)) (define disambiguated
null (let ()
(list (define (bib->para bib [disambiguation #f])
(make-table (define collect-target
bib-table-style (list (make-target-element
(map (lambda (k)
(list
(make-paragraph
plain
(list
(make-collect-element
#f #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 #f
(list (auto-bib-entry-element k)) (list (author-element-cite (auto-bib-author bib)))))
`(autobib ,(auto-bib-key k)))) ;; store the date
(lambda (ci) (collect-put! ci
(collect-put! ci `(autobib-date ,(auto-bib-key bib)) ;; (list which key)
`(autobib-author ,(auto-bib-key k)) (make-element #f (list (auto-bib-date bib))))
(make-element ;; store how to disambiguate it from other like citations.
#f (collect-put! ci
(list `(autobib-disambiguation ,(auto-bib-key bib))
(author-element-cite (auto-bib-author k))))) (or disambiguation 'unambiguous)))
(collect-put! ci (list
`(autobib-date ,(auto-bib-key k)) (make-paragraph plain
(make-element (list (make-collect-element #f collect-target collect)))))
#f ;; create the bibliography with disambiguations added.
(list (define-values (last num-ambiguous rev-disambiguated*)
(auto-bib-date k)))))))))) (for/fold ([last #f] [num-ambiguous 0] [rev-disambiguated '()]) ([bib (in-list bibs)])
bibs))) (define ambiguous?? (and last (ambiguous? last bib)))
null))) (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) (define-syntax (define-cite stx)
(begin (syntax-parse stx
(define group (make-bib-group (make-hasheq))) [(_ cite* citet generate-bibliography
(define (~cite #:sort? [sort? #t] bib-entry . bib-entries) (~optional (~seq #:disambiguate fn)
(add-cites group (cons bib-entry bib-entries) sort?)) #:defaults ([fn #'#f])))
(define (citet bib-entry . bib-entries) (syntax/loc stx
(add-inline-cite group (cons bib-entry bib-entries))) (begin
(define (generate-bibliography #:tag [tag "doc-bibliography"] #:sec-title [sec-title "Bibliography"]) (define group (make-bib-group (make-hasheq)))
(gen-bib tag group sec-title)))) (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) (define (ends-in-punc? e)
(regexp-match? #rx"[.!?,]$" (content->string e))) (regexp-match? #rx"[.!?,]$" (content->string e)))
@ -169,28 +217,28 @@
[(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 ,@(if (ends-in-punc? author)
,@(if (ends-in-punc? author) '(" ")
'(" ") '(". ")))
'(". "))) null)
null) ;; (if is-book? null '(ldquo))
;; (if is-book? null '(ldquo)) (if is-book?
(if is-book? (list (italic title))
(list (italic title)) (decode-content (list title)))
(decode-content (list title))) (if (ends-in-punc? title)
(if (ends-in-punc? title) null
null '("."))
'(".")) ;; (if is-book? null '(rdquo))
;; (if is-book? null '(rdquo)) (if location
(if location `(" " ,@(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,35 +355,39 @@
"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) " / "))
(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 #f
(let loop ([names names] [prefix 0]) (let loop ([names names] [prefix 0])
(if (null? (cdr names)) (cond [(null? (cdr names))
(case prefix (case prefix
[(0) (list (car names))] [(0) names]
[(1) (if (other-author-element? (car names)) [(1) (if (other-author-element? (car names))
(list " et al.") (list " et al.")
(list " and " (car names)))] (list " and " (car names)))]
[else (if (other-author-element? (car names)) [else (if (other-author-element? (car names))
(list ", et al.") (list ", et al.")
(list ", and " (car names)))]) (list ", and " (car names)))])]
(case prefix [else
[(0) (list* (car names) (case prefix
(loop (cdr names) (add1 prefix)))] [(0) (list* (car names)
[else (list* ", " (loop (cdr names) (add1 prefix)))]
(car names) [else (list* ", "
(loop (cdr names) (add1 prefix)))]))) (car names)
(string-join (map author-element-names names) " / ") (loop (cdr names) (add1 prefix)))])]))
(case (length names) slash-names
[(1) (author-element-cite (car names))] cite))
[(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)))]))))
(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