Better disambiguation for autobib. Delays rendering bib elements because the disambiguation must be accounted for.

original commit: f3dc5796bedcc4390382f0c9d6790caf68d11a99

collects/scriblib/autobib.rkt

@@ -1,6 +1,7 @@
 #lang at-exp racket/base
 (require scribble/manual
          racket/list
+         racket/date
          scribble/core
          scribble/decode
          scribble/html-properties
@@ -27,65 +28,84 @@
 (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 auto-bib (author date title location url is-book? key specific))
 (define-struct bib-group (ht))
 
 (define-struct (author-element element) (names cite))
 (define-struct (other-author-element author-element) ())
 
 ;; render the use of a citation.
-(define (add-cite group bib-entry which with-specific? with-disambiguation?)
+(define (add-cite group bib-entry which with-specific? disambiguation)
   (let ([key (auto-bib-key bib-entry)])
     (hash-set! (bib-group-ht group) key bib-entry)
     (make-delayed-element
      (lambda (renderer part ri)
        ;; (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))
+             (cond [(and disambiguation
+                         (or (pair? (cdr disambiguation))
+                             (and (null? (cdr disambiguation))
+                                  ))) ;; should be a list of bib-entries with same author/date
+                    (define disambiguation*
+                      (add-between (for/list ([bib (in-list disambiguation)])
+                                     (define maybe-disambiguation
+                                       (resolve-get part ri `(autobib-disambiguation ,(auto-bib-key bib))))
+                                     (case maybe-disambiguation
+                                       [(unambiguous) #f]
+                                       [else maybe-disambiguation]))
+                                   ","))
+                    (cond [(not (car disambiguation*)) '()] ;; the bib was unambiguous
+                          [else
+                           (list (make-link-element #f (list disambiguation*) `(autobib ,(auto-bib-key bib-entry))))])]
+                   [else '()])))
      (lambda () "(???)")
      (lambda () "(???)"))))
 
-(define (add-inline-cite group bib-entries)
+(define (add-date-cites group bib-entries delimiter maybe-date<? maybe-date=?)
+  (define date<? (or maybe-date<? default-date<?))
+  (define date=? (or maybe-date=? default-date=?))
+  (define sorted-by-date (sort bib-entries date<?))
+  (define partitioned-by-ambiguity
+    (let-values ([(last last-ambiguous-list partition)
+                  (for/fold ([last #f]
+                             [currently-ambiguous '()]
+                             [partition '()])
+                      ([bib (reverse sorted-by-date)])
+                    (cond [(and last (date=? last bib)) ;; ambiguous! group.
+                           (values bib (cons bib currently-ambiguous) partition)]
+                          ;; first element.
+                          [(not last) (values bib (list bib) partition)]
+                          ;; not ambiguous. Start next group.
+                          [else (values bib (list bib) (cons currently-ambiguous partition))]))])
+      (reverse (cons last-ambiguous-list partition))))
+  (cond [(null? bib-entries) '()]
+        [else
+         (add-between
+          (for/list ([part (in-list partitioned-by-ambiguity)])
+            (add-cite group (car part) 'autobib-date #t part))
+          delimiter)]))
+
+(define (add-inline-cite group bib-entries bib-date<? bib-date=?)
   (for ([i bib-entries])
     (hash-set! (bib-group-ht group) (auto-bib-key i) i))
   (when (and (pair? (cdr bib-entries))
-             (not (apply equal? (map (compose author-element-names auto-bib-author)  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"
            (map (compose author-element-names auto-bib-author) bib-entries)))
   (make-element
    #f
    (list (add-cite group (car bib-entries) 'autobib-author #f #f)
          'nbsp
-         "("
+         "(" (add-date-cites group bib-entries "; " bib-date<? bib-date=?) ")")))
-         (let loop ([keys bib-entries])
-           (if (null? (cdr keys))
-               (add-cite group (car keys) 'autobib-date #t #t)
-               (make-element
-                #f
-                (list (loop (list (car keys)))
-                      "; "
-                      (loop (cdr keys))))))
-         ")")))
 
-(define (add-cites group bib-entries sort?)
+;; This allows citing multiple sources in one @cite. Groups of citations are separated by semicolons.
+(define (add-cites group bib-entries sort? bib-date<? bib-date=?)
   (define-values (groups keys)
     (for/fold ([h (hash)] [ks null]) ([b (reverse bib-entries)])
       (let ([k (author-element-names (auto-bib-author b))])
@@ -102,38 +122,50 @@
           #f
           (list*
            (add-cite group (car v) 'autobib-author #f #f)
-           " "
+           " " (add-date-cites group v ", " bib-date<? bib-date=?)))))
-           (add-between
-            (for/list ([b v]) (add-cite group b 'autobib-date #t #t))
-            ", ")))))
      "; ")
    (list ")"))))
 
-(define (extract-bib-key b)
+(define (extract-bib-author b)
-  (author-element-names (auto-bib-author b)))
+  (or (auto-bib-author b)
+      (org-author-name (auto-bib-title b))))
 
-(define (extract-bib-year b)
+(define (extract-bib-key b)
-  (string->number (auto-bib-date b)))
+  (author-element-names (extract-bib-author b)))
+
+;; Defaults only care about the year.
+(define (default-render-date-bib date)
+  (make-element #f (list (number->string (date-year date)))))
+(define (default-render-date-cite date)
+  (make-element #f (list (number->string (date-year date)))))
+(define (default-date<? b0 b1)
+  (< (date-year (auto-bib-date b0)) (date-year (auto-bib-date b1))))
+(define (default-date=? b0 b1)
+  (= (date-year (auto-bib-date b0)) (date-year (auto-bib-date b1))))
 
 ;; 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))))))
+  (make-element #f (list (format "~a" (integer->char (+ 97 n))))))
 
-(define (gen-bib tag group sec-title maybe-disambiguator)
+(define (gen-bib tag group sec-title maybe-disambiguator maybe-render-date-bib maybe-render-date-cite maybe-date<? maybe-date=?)
   (define disambiguator (or maybe-disambiguator default-disambiguation))
+  (define date<? (or maybe-date<? default-date<?))
+  (define date=? (or maybe-date=? default-date=?))
+  (define render-date-bib (or maybe-render-date-bib default-render-date-bib))
+  (define render-date-cite (or maybe-render-date-cite default-render-date-cite))
   (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)
+             (auto-bib-date a)
-             (extract-bib-year b)
+             (auto-bib-date b)
-             (< (extract-bib-year a) (extract-bib-year b)))))
+             (date<? a b))))
   (define (ambiguous? a b)
     (and (string-ci=? (extract-bib-key a) (extract-bib-key b))
-         (extract-bib-year a)
+         (auto-bib-date a)
-         (extract-bib-year b)
+         (auto-bib-date b)
-         (= (extract-bib-year a) (extract-bib-year b))))
+         (date=? a b)))
   (define bibs (sort (hash-values (bib-group-ht group))
                      author/date<?))
   (define disambiguated
@@ -142,7 +174,7 @@
         (define collect-target
           (list (make-target-element
                   #f
-                  (list (auto-bib-entry-element bib))
+                  (list (bib->entry bib disambiguation render-date-bib))
                   `(autobib ,(auto-bib-key bib)))))
         ;; Communicate to scribble's resolve step.
         (define (collect ci)
@@ -151,11 +183,11 @@
                         `(autobib-author ,(auto-bib-key bib)) ;; (list which key)
                         (make-element
                          #f
-                         (list (author-element-cite (auto-bib-author bib)))))
+                         (list (author-element-cite (extract-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))))
+                        (make-element #f (list (render-date-cite (auto-bib-date bib)))))
           ;; store how to disambiguate it from other like citations.
           (collect-put! ci
                         `(autobib-disambiguation ,(auto-bib-key bib))
@@ -189,68 +221,109 @@
              (list (make-table bib-table-style disambiguated))
              null))
 
+(define (bib->entry bib disambiguation render-date-bib)
+  (define-values (author date title location url is-book?)
+    (values (auto-bib-author bib)
+            (auto-bib-date bib)
+            (auto-bib-title bib)
+            (auto-bib-location bib)
+            (auto-bib-url bib)
+            (auto-bib-is-book? bib)))
+  (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 `(" "
+                            @,(if disambiguation
+                                  `("(" ,@(decode-content (list (render-date-bib date))) ,disambiguation ")")
+                                  (decode-content (list (render-date-bib date))))
+                            ".")
+                     null)
+                 (if url `(" " ,(link url (make-element 'url (list url)))) null))))
+
 (define-syntax (define-cite stx)
   (syntax-parse stx
-    [(_ cite* citet generate-bibliography
+    [(_ (~var ~cite) citet generate-bibliography
-        (~optional (~seq #:disambiguate fn)
+        (~or (~optional (~seq #:disambiguate fn) #:defaults ([fn #'#f]))
-                   #:defaults ([fn #'#f])))
+             (~optional (~seq #:render-date-in-bib render-date-bib) #:defaults ([render-date-bib #'#f]))
+             (~optional (~seq #:render-date-in-cite render-date-cite) #:defaults ([render-date-cite #'#f]))
+             (~optional (~seq #:date<? date<?) #:defaults ([date<? #'#f]))
+             (~optional (~seq #:date=? date=?) #:defaults ([date=? #'#f]))) ...)
      (syntax/loc stx
        (begin
          (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? date<? date=?))
          (define (citet bib-entry . bib-entries)
-           (add-inline-cite group (cons bib-entry bib-entries)))
+           (add-inline-cite group (cons bib-entry bib-entries) date<? date=?))
          (define (generate-bibliography #:tag [tag "doc-bibliography"] #:sec-title [sec-title "Bibliography"])
-           (gen-bib tag group sec-title fn))))]))
+           (gen-bib tag group sec-title fn render-date-bib render-date-cite date<? date=?))))]))
 
 (define (ends-in-punc? e)
   (regexp-match? #rx"[.!?,]$" (content->string e)))
 
+(define (understand-date inp)
+  ;; Currently there is no string->date function.
+  ;; Common usage of autobib has assumed that this should be the year.
+  (cond [(or (string? inp) (number? inp))
+         (define year
+           (cond [(string? inp) (string->number inp)]
+                 [else inp]))
+         (date 0 0 0 1 1 ;; second/minute/hour/day/month
+               year
+               ;; week-day/year-day/daylight savings time?/timezone offset
+               0 0 #f 0)]
+        [(date? inp) inp]
+        [(not inp) #f] ;; no date is fine too.
+        [else (error 'make-bib "Not given a value that represents a date.")]))
+
+;; We delay making the element for the bib-entry because we may need to add
+;; disambiguations during gen-bib.
 (define (make-bib #:title title
                   #:author [author #f]
                   #:is-book? [is-book? #f]
                   #:location [location #f]
                   #:date [date #f]
                   #:url [url #f])
-  (let* ([author (cond
+  (define author*
-                  [(not author) #f]
+    (cond [(not author) #f]
-                  [(author-element? author) author]
+          [(author-element? author) author]
-                  [else (parse-author author)])]
+          [else (parse-author author)]))
-         [content
+  (define parsed-date (understand-date date))
-          (append
+  (make-auto-bib author* parsed-date title location url is-book?
-           (if author
+                 (content->string
-               `(,author
+                  (make-element bibentry-style
-                 ,@(if (ends-in-punc? author)
+                                (append
-                       '(" ")
+                                 (if author* (list author*) null)
-                       '(". ")))
+                                 (list title)
-               null)
+                                 (if location (decode-content (list location)) null)
-           ;; (if is-book? null '(ldquo))
+                                 (if date (decode-content (list (default-render-date-bib parsed-date))) null)
-           (if is-book?
+                                 (if url (link url (make-element 'url (list url))) null))))
-               (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)
-     elem
-     (content->string elem)
-     "")))
 
 (define (in-bib bib where)
   (make-auto-bib
    (auto-bib-author bib)
    (auto-bib-date bib)
-   (auto-bib-entry-element bib)
+   (auto-bib-title bib)
+   (auto-bib-location bib)
+   (auto-bib-url bib)
+   (auto-bib-is-book? bib)
    (auto-bib-key bib)
    ;; "where" is the only specific part of auto-bib elements currently.
    (string-append (auto-bib-specific bib) where)))

collects/scriblib/scribblings/autobib.scrbl

@@ -9,17 +9,31 @@
 @defmodule[scriblib/autobib]
 
 
-@defform[(define-cite ~cite-id citet-id generate-bibliography-id [#:disambiguate disambiguator])]{
+@defform[(define-cite ~cite-id citet-id generate-bibliography-id
+                      [#:disambiguate disambiguator]
+                      [#:render-date-bib render-date]
+                      [#:render-date-cite render-date]
+                      [#:date<? date-compare]
+                      [#:date=? date-compare])]{
 
 Binds @racket[~cite-id], @racket[citet-id], and
 @racket[generate-bibliography-id], which share state to accumulate and render
-citations. If two citations' references would render the same but are
+citations. If two citations' references would render the same (as judged by equal authors and dates are @racket[date=?]) 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?)]
 
+Dates in citations and dates in the bibliography may be rendered differently,
+as specified by the optionally given @racket[render-date] functions, which have the contract
+
+@racketblock[(-> date? element?)]
+
+The dates of citations are stored as @racket[date] values, and the granularity in which they are compared and rendered are, by default, by year. The comparison functions have contract
+
+@racketblock[(-> date? date? boolean?)]
+
 The function bound to @racket[~cite-id] produces a citation referring
 to one or more bibliography entries with a preceding non-breaking
 space, by default sorting the entries to match the bibliography order.
@@ -59,7 +73,7 @@ Returns @racket[#t] if @racket[v] is a value produced by
                    [#:author author any/c #f]
                    [#:is-book? is-book? any/c #f]
                    [#:location location any/c #f]
-                   [#:date date any/c #f]
+                   [#:date date (or/c #f date? exact-nonnegative-integer? string?) #f]
                    [#:url url string? #f])
          bib?]{
 
@@ -70,6 +84,9 @@ supplied. Functions like @racket[proceedings-location],
 @racket[author-name], and @racket[authors] help produce elements in a
 standard format.
 
+Dates are internally represented as @racket[date] values, so a @racket[date]
+may be given, or a number or string that represent the year.
+
 An element produced by a function like @racket[author-name] tracks
 first, last names, and name suffixes separately, so that names can be
 ordered and rendered correctly. When a string is provided as an author