;; BibTeX support, for parsing .bib files.
;;
;; The author and format-string parsing are in a separate module.
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2024 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

(module 'parse-bib2* 'unicode 'klipspringer 'json)
(define-macro (%module-verbosity-flag%) 2)

;; Given a biblex? source, return a (symbol? -> entry?) hash.
;; If there is a parse failure, or other beastie-error, then we catch
;; it, and simply discard the entry.  Is that the best thing to do?
(define (parse-bibtex/klipspringer src)

  (define (resolve-crossrefs* entries)
    ;; entries is a hash of (symbol? -> entry?) objects
    (for-each (λ (k+v)
                ;; If this entry has a 'crossref, then call
                ;; entry-set-crossref! to set that entry as this entry crossref.
                ;; In doing so, however, follow a chain of crossrefs
                ;; to detect if they have a cycle, and do _not_ set
                ;; the crossref in that case.
                (let ((this-key (car k+v))
                      (this-entry (cdr k+v)))
                  (let ((xref-entry
                         (let loop ((e this-entry)
                                    (first-xr #f) ;filled in with the first xref we find
                                    (seen (list this-key)))
                           (let ((xr (cond ((entry-field e 'crossref)
                                            => (λ (x)
                                                 (ustring->symbol x)))
                                           (else #f))))
                             (if xr
                                 (cond ((entries xr)
                                        => (λ (next-e)
                                             (if (memq (entry-key next-e) seen)
                                                 (begin
                                                   (print-warning "circular crossrefs from entry ~a (~s)"
                                                                  this-key
                                                                  (string-join
                                                                   (map symbol->string (reverse! seen))
                                                                   " -> "))
                                                   #f)
                                                 (loop next-e
                                                       (or first-xr next-e)
                                                       (cons (entry-key next-e) seen)))))
                                       (else
                                        (print-warning "entry ~a has crossref ~a, which doesn't exist"
                                                       this-key xr)
                                        first-xr))
                                 first-xr)))))
                    (when xref-entry
                      (entry-set-crossref! this-entry xref-entry)))))
              entries)
    entries)

  ;; src is a biblex? object
  (resolve-crossrefs*
   (apply hash-table
          (let get-entry ((inp src)
                          (res '()))    ;ends up a list ('key entry? 'key entry? ...)
            (catch 'beastie
              (λ ()
                (receive (entry next-inp)
                    (parse-result2 (<or> bibtex-entry $eof) inp)
                  ;; this entry result is from parse-bib2.scm:make-bibtex-entry-result*,
                  ;; and consists of
                  ;; (type/symbol key/symbol (key/symbol . value/ustring) ...)
                  (print-info "parse-bibtex/klipspringer: entry=~s" entry)
                  (cond ((eof-object? entry) res)
                        ((not entry) (get-entry next-inp res)) ;returned #f -- @string
                        ((eqv? (car entry) 'preamble) ;(list 'preamble ustring? ...)
                         (append-preamble! (cdr entry))
                         (get-entry next-inp res))
                        (else ; (type/symbol? key/symbol? (field/symbol? . value/ustring?) ...)
                         (get-entry next-inp
                                    `(,(cadr entry)
                                      ,(make-bibtex-entry (car entry)
                                                          (cadr entry)
                                                          (cddr entry))
                                      . ,res))))))
              (λ (tag args . info)
                ;;(eprintf "error: tag=~s  args=~s~%" tag args)
                (print-warning "beastie error parsing ~a: ~a" (src 'location) (car args))
                ;; give up, and return the entries accumulated so far
                res))))))

(define/provide (parse-bibtex-string str)
  #"""`(parse-bibtex-string str)` : parse the contents of the string,
  taken to be the contents of a `.bib` file.  See `parse-bibtex-file`."""
  (parse-bibtex/klipspringer (make-biblex* (make-unicode-reader/string str))))
(define/provide (parse-bibtex-file fn)
  #"""`(parse-bibtex-file fn)` : parses the contents of the indicated
  file, and returns a `(key -> entry)` hash-table, where the key is a
  symbol indicating an entry key, and the entry is an object of type
  `entry?`.

  If any entries are mangled, and fail to parse, then they are discarded
  with a warning."""
  (parse-bibtex/klipspringer (make-biblex* (make-unicode-reader/file fn))))

;;;; Entries
;;
;; Entries are parsed into an opaque entry? type, with a variety of
;; accessor functions, listed below.
;;
;; Note: The btxhak document says that
;;
;;     a cross-referenced entry must occur later in the database files
;;     than every entry that cross-references it. [...] a cross-
;;     referenced entry may not itself reliably cross reference an
;;     entry.
;;
;; There is no provision here for backward-pointing
;; crossrefs, nor (therefore) any need for checking of circular
;; references.  We could subsequently add both of these here, by
;; replacing the logic below with a final crossref-resolution pass
;; (that would incidentally require preserving the complete set of
;; entries).  We do support chains of crossrefs, though.
;;
;; Entry lookup: most of the processing of entries is done in a nicely
;; functional way -- that is, (entry? -> result), one way or another
;; -- but as soon as we start thinking about crossrefs, we need a way
;; of looking up entries by key.  We manage this directly, by
;; maintaining a reference to a cross-referenced entry, in each of the
;; entries with the corresponding `crossref` key.  This is managed at
;; parsing/collecting time,by the MAKE-BIBENTRY-ACCUMULATOR* function,
;; which receives entries parsed from the .bib file.  I'm not sure
;; whether this counts, in style terms, as elegant or clunky.
;;
;; Thus the only inter-entry state is for the benefit of handling
;; crossrefs within bst processing.  If we weren't caring about
;; crossrefs, or if we were doing all of the processing in scheme
;; rather than bst, there would be other natural ways to handle this.
;; Even if we were doing a different sort of processing -- for
;; example, only concerned with extracting entries from a .bib file --
;; then the accumulator given to CALL-PARSER/ACCUMULATOR* could be somewhat
;; simpler.  A previous version of this worked with a global *ENTRY*
;; variable, which was temporarily reset (using let-temporarily)
;; within a (with-entry ...) form.  But using a global seemed highly
;; unappealing.

;; MAKE-BIBTEX-ENTRY : symbol? symbol? (listof (cons/c symbol? string?)) -> entry?
;; Create an entry, given symbols for type and key.
;; Arguments type and key are symbols, fields is an alist.
;; This function exists to help the 'entry' production in parse-bibtex.y.
(struct entry* type key fields variables (xref :mutable)
        ;; skip the :guard procedure -- all checking is done by make-bibtex-entry
        ;; :guard (λ (type key fields variables xref)
        ;;          (if (and (symbol? type)
        ;;                   (symbol? key)
        ;;                   (hash-table? fields)
        ;;                   (hash-table? variables)
        ;;                   (not xref))
        ;;              (values type key fields variables xref)
        ;;              (beastie-error "malformed construction of make-entry with type:~s key:~s fields:~s"
        ;;                             type key fields)))
        )

(define (make-bibtex-entry type key fields)
  (print-info "make-bibtex-entry type=~s key=~s fields=~s" type key fields)
  (make-entry* type
               key
               (apply hash-table        ;alist->hash-table, with type checking
                      (apply append
                             (map (λ (p)
                                    (let ((k (car p))
                                          (v (cdr p)))
                                      (if (and (symbol? k)
                                               (ustring? v))
                                          (list k v)
                                          (beastie-error "malformed construction of make-entry with type:~s key:~s fields:~s"
                                                         type key fields))))
                                  fields)))
               (make-hash-table 8 eq?)  ;variables
               #f))

(define/provide (entry? x)
  #"""`entry? : any -> boolean?` : Return true if the argument is a BibTeX entry.
  See PARSE-BIBTEX-FILE."""
  (entry*? x))
(define/provide (entry-type e)
  #"""`entry-type : entry? -> symbol?` : Return the type of the entry
  (ie, article, book, ...) as a symbol"""
  (entry*-type e))
(define/provide (entry-key e)
  #"""`entry-key : entry? -> symbol?` :
  Return the citation key of the entry, as a symbol"""
  (entry*-key e))

(define/provide (entry-fields/alist e)
  #"""`entry-fields/alist : entry-> (listof (cons symbol? value))` :
  Return the fields of the entry, as an alist: (listof (cons symbol? value))"""
  (map values (entry*-fields e)))

(define/provide (entry-fields e)
  #"""`entry-fields : entry-> (listof symbol?)` :
  Return the field names of the entry, as a list of symbols."""
  (map car (entry*-fields e)))

(define/provide (entry-field e k)
  #"""`entry-field : entry? symbol? -> (or ustring? #f)` :
  Return one field from the entry, keyed by a symbol representing the field name.

  Return #f if the field is not present."""
  (hash-table-ref (entry*-fields e) k))

(define/provide (entry-field/authorlist e k)
  #"""`(entry-field/authorlist entry? symbol?)` : like `entry-field`,
  except that the value is assumed to be an author list,
  and is parsed to give a list of `author?` objects,
  or `#f` if the field is not present."""
  (let ((a (hash-table-ref (entry*-fields e) k)))
    (and a
         (parse-author-list a))))

(define/provide (entry-get-local-variable e k)
  #"""`entry-get-local-variable : entry? symbol? -> (or any #f)` :
  in entry E, get the entry-local value of a variable K which has been set with
  `entry-set-local-variable!`  Return `#f` if the field is not present.
  We do not (at present) constrain the types of what can be stored here."""
  (hash-table-ref (entry*-variables e) k))

(define/provide (entry-set-local-variable! e k v)
  #"""`entry-set-local-variable! : entry? symbol? any -> string?` :
  In `(entry-set-local-variable! E K V)` in entry E, set the variable 'K to value V; also returns V.
  This provides a bit of local storage while processing.
  We do not (at present) constrain the types of what can be stored here."""
  (unless (symbol? k)
    (beastie-error "entry-set-local-variable!: only symbol-keyed data can be stored in an entry"))
  (hash-table-set! (entry*-variables e) k v))

(define/provide (entry-field/crossref entry k)
  #"""`entry-field/crossref : entry? symbol? -> (or string? #f)` :
  As `ENTRY-FIELD`, except that, if the entry has a crossref,
  then we follow the chain of such references."""
  (unless (entry? entry)
    (beastie-error "entry-field/crossref given ~s, not entry?" entry))
  ;; Find the value of the field by working through the list of crossrefs.
  ;; We detect cycles here, but this should be redundant,
  ;; since they should have been avoided above, in parse-bibtex.
  (define (show-found found)
    (string-join (map symbol->string (reverse found)) " -> "))
  (define (follow e found)
    (cond ((entry-field e k))
          ((entry-crossref e)
           => (λ (xr)
                (let ((xr-key (entry-key xr)))
                  (if (memq xr-key found)
                      (begin
                        (print-warning "circular crossrefs from entry ~a (~s)" k (show-found (cons xr-key found)))
                        #f)
                      (follow xr (cons xr-key found))))))
          (else
           ;; we've run out of crossrefs => the field is missing
           #f)))
  (follow entry (list (entry-key entry))))

(define (entry-set-crossref! e xr)
  (set-entry*-xref! e xr))

(define/provide (entry-crossref e)
  #"""`entry-crossref : entry? -> (or entry? #f)` :
  If the entry has a crossref field, then this returns that entry (as opposed to the crossref key)"""
  (entry*-xref e))

(define/provide (entry<? a b)
  #"""`entry<? : entry? entry? -> boolean?` : Provide a sort order on entries,
  returning `#t` if the first argument should be ordered before the second.
  This is at present based on the entry-key, but may change in future."""
  (symbol<? (entry*-key a) (entry*-key b)))

;; Manage information about entry types.
(struct bibtex-entry-type
        description
        required                        ;list of required fields for the given entry's type
        known)                          ;list of known fields

(define bibtex-entry-type-info
  (let ((*bibtex-known-entry-types*
         (hash-table
          'article                      ;type
          (make-bibtex-entry-type
           "An article from a journal or magazine" ;description
           '(author title journal year)             ;required
           '(volume number pages month note))        ;known but optional

          'book
          (make-bibtex-entry-type
           "A book with an explicit publisher"
           '((author editor) title publisher year)
           '((volume number) series address edition month note))

          'booklet
          (make-bibtex-entry-type
           "A work that is printed and bound, but without a named publisher or sponsoring institution"
           '(title)
           '(author howpublished address month year note))

          'conference
          (make-bibtex-entry-type
           "The same as INPROCEEDINGS, included for Scribe compatibility"
           '(author title booktitle year)
           '(editor (volume number) series pages address month organization publisher note))

          'inbook
          (make-bibtex-entry-type
           "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages"
           '((author editor)          ;the docs are 'author or editor'
             title
             (chapter pages)            ;...and 'chapter and/or pages'
             publisher year)
           '((volume number) series type address edition month note))

          'incollection
          (make-bibtex-entry-type
           "A part of a book having its own title"
           '(author title booktitle publisher year)
           '(editor volume or number series type chapter pages address edition month note))

          'inproceedings
          (make-bibtex-entry-type
           "An article in a conference proceedings"
           '(author title booktitle year)
           '(editor (volume number) series pages address month organization publisher note))

          'manual
          (make-bibtex-entry-type
           "Technical documentation"
           '(title)
           '(author organization address edition month year note))

          'mastersthesis
          (make-bibtex-entry-type
           "A Master’s thesis"
           '(author title school year)
           '(type address month note))

          'misc
          (make-bibtex-entry-type
           "Use this type when nothing else fits"
           '()
           '(author title howpublished month year note))

          'phdthesis
          (make-bibtex-entry-type
           "A PhD thesis"
           '(author title school year)
           '(type address month note))

          'proceedings
          (make-bibtex-entry-type
           "The proceedings of a conference"
           '(title year)
           '(editor (volume number) series address month organization publisher note))

          'techreport
          (make-bibtex-entry-type
           "A report published by a school or other institution, usually numbered within a series"
           '(author title institution year)
           '(type number address month note))

          'unpublished
          (make-bibtex-entry-type
           "A document having an author and title but not formally published"
           '(author title note)
           '(month year))

          '_unknown
          (make-bibtex-entry-type
           "Default unknown entry type" '() '()))))
    (λ (e)
      (or (*bibtex-known-entry-types* (entry-type e))
          (*bibtex-known-entry-types* '_unknown)))))

(define (make-entry-type-comparator entry-type)
  ;; make a comparator function ((symbol? . any) (symbol? . any) -> boolean?)
  ;; true if the first field should be ordered before the second
  ;; (required before known before unknown, and alphabetical within those)
  (let ((required (bibtex-entry-type-required entry-type))
        (known    (bibtex-entry-type-known entry-type)))
    (λ (key-a key-b)
      ;; sort two items of type symbol?
      (let ((class-a (cond ((memv key-a required) 0)
                           ((memv key-a known)    1)
                           (else                  2)))
            (class-b (cond ((memv key-b required) 0)
                           ((memv key-b known)    1)
                           (else                  2))))
        (if (= class-a class-b)
            (symbol<? key-a key-b)
            (< class-a class-b))))))

;; Hmm: would it be better to let this just return null to indicate
;; 'nothing missing'?
(define/provide (entry-missing-fields e)
  #"""`entry-missing-fields : entry? -> (or (listof (or symbol? (listof symbol?))) #f)` :
  Return a list of required fields missing from the entry,
  or `#f` if there are none.

  If alternate fields are required -- eg, book requires author or
  editor -- then the list entry will be a list of symbols, rather than
  a symbol.

  The list of known entry types, and their required fields, is below.
  The list of optional fields is included here, for completeness.

    * `article` : An article from a journal or magazine.
      _Required_: author, title, journal, year.
      _Optional_: volume, number, pages, month, note.
    * `book` : A book with an explicit publisher.
      _Required_: (author or editor), title, publisher, year.
      _Optional_: (volume or number), series, address, edition, month, note.
    * `booklet` : A work that is printed and bound, but without a named publisher or sponsoring institution.
      _Required_: title.
      _Optional_: author, howpublished, address, month, year, note.
    * `conference` : The same as INPROCEEDINGS, included for Scribe compatibility.
      _Required_: author, title, booktitle, year.
      _Optional_: editor, (volume or number), series, pages, address, month, organization, publisher, note.
    * `inbook` : A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.
      _Required_: (author or editor), title, (chapter or pages), publisher, year.
      _Optional_: (volume or number), series, type, address, edition, month, note.
    * `incollection` : A part of a book having its own title.
      _Required_: author, title, booktitle, publisher, year.
      _Optional_: editor, volume, or, number, series, type, chapter, pages, address, edition, month, note.
    * `inproceedings` : An article in a conference proceedings.
      _Required_: author, title, booktitle, year.
      _Optional_: editor, (volume or number), series, pages, address, month, organization, publisher, note.
    * `manual` : Technical documentation.
      _Required_: title.
      _Optional_: author, organization, address, edition, month, year, note.
    * `mastersthesis` : A Master’s thesis.
      _Required_: author, title, school, year.
      _Optional_: type, address, month, note.
    * `misc` : Use this type when nothing else fits.
      _Required_: [None].
      _Optional_: author, title, howpublished, month, year, note.
    * `phdthesis` : A PhD thesis.
      _Required_: author, title, school, year.
      _Optional_: type, address, month, note.
    * `proceedings` : The proceedings of a conference.
      _Required_: title, year.
      _Optional_: editor, (volume or number), series, address, month, organization, publisher, note.
    * `techreport` : A report published by a school or other institution, usually numbered within a series.
      _Required_: author, title, institution, year.
      _Optional_: type, number, address, month, note.
    * `unpublished` : A document having an author and title but not formally published.
      _Required_: author, title, note.
      _Optional_: month, year.

  If the entry type is not a known one, then nothing is required,
  so return `#f`."""
  (let ((res
          (fold (λ (required-field knil)
                  (cond ((list? required-field)
                         (let loop ((rf required-field))
                           (cond ((null? rf) (cons required-field knil))
                                 ((entry-field e (car rf)) knil)
                                 (else (loop (cdr rf))))))
                        ((entry-field e required-field)
                         knil)
                        (else
                         (cons required-field knil))))
                '()
                (bibtex-entry-type-required (bibtex-entry-type-info e)))))
    (if (null? res)
        #f
        res)))

;; We could fiddle about with pretty-printing the output almost
;; indefinitely, but what we have here is fine.
;;
;; Note that this is intended to be readable by BibTeX (and beastie!),
;; and should not therefore produce scheme-readable values.
(define/provide (entry-print! e . rest)
  #"""`entry-print! : entry? [output-port?] -> unspecified` :
  print the given entry, in BibTeX format, to the optional port (stdout if missing).
  There is some normalisation in the output:
  required fields are placed before optional ones,
  which are in turn before unrecognised ones.

  Note that any string abbreviations (ie, BibTeX fields like `month=jan`)
  will have been expanded before this point, so won't round-trip into this output."""
  (entry-print* e
                (if (null? rest)
                    (current-output-port)
                    (car rest))))

(define (entry-print* e p)
  ;(eprintf "entry-print* ~s~%" e)
  (let ((type (entry-type e))
        (key (entry-key e))
        (fields (entry-fields/alist e)))
    (format p "@~a{~a" type key)
    (let ((field<? (make-entry-type-comparator
                    (bibtex-entry-type-info e))))
      (for-each (λ (kv)
                  (let ((k (car kv))
                        (v (cdr kv)))
                    (format p ",~%  ~a = " k)
                    (cond ((or (string? v) (ustring? v))
                           (format p "{~a}" v))
                          ((symbol? v)
                           (display v p))
                          (else
                           (eprintf "entry-print*: unexpected entry element: ~s~%" v)))))
                (sort! fields
                       (λ (a b)
                         (field<? (car a) (car b))))))
    (format p "}~%~%")))

(define/provide (write-bibtex/bib! db)
  #"""`write-bibtex/bib! : (listof entry?) -> unspecified` :
  Write out a parsed BibTeX database (in the form of a list of entries),
  to the current output port, in .bib syntax."""
  (for-each entry-print! (map cdr db)))

;; FILTER-ENTRIES : (listof entry?) (or/c (listof symbol?) 'all)
;; Return the entries in the given ENTRY-LIST which have keys which
;; appear in the list of symbols in CITATION-LIST.
(define/provide (filter-entries entry-list citation-list)
  #"""`filter-entries : (listof entry?) (listof symbol?)` :
  In `(filter-entries entry-list citation-list)`, return the entries in the given ENTRY-LIST which have keys
  which appear in the list of symbols in CITATION-LIST."""
  (if (eqv? citation-list 'all)
      entry-list
      (let ((citation-set (make-set/eqv citation-list)))
        (filter (lambda (e) (citation-set (entry-key e)))
                entry-list))))

;; A citation? object contains:
;;
;;   * entry key (symbol)
;;   * a formatted reference, such as "(Gray, 2023)" (string), for inclusion
;;     in the running text, as the citation of the source; note that
;;     these are all cite-as-parenthetical-note citations, and there's
;;     no current support for cite-as-noun or cite-as-year versions.
;;   * a <li> element for inclusion in the bibliography (xexpr)
(define-values (make-citation citation?)
  (let ((*citation-label* 'citation))
    (values
     (λ (entry ref li-xexpr)
       #"""`make-citation : entry? string? xexpr? -> citation?` :
       Use `(make-citation entry reference li)` to
       create a `citation?` object.  The ENTRY is the parse BibTeX entry,
       the REFERENCE is a label such as (Jones 1999), and the LI is the bibliographic
       information formatted as a <li> xexpr?.  This sort of object is created by programs
       which do the main work of formatting bibliographic information to HTML."""
       (vector *citation-label* entry ref li-xexpr))
     (λ (x)
       #"""`citation? : any -> boolean?` :
       true if X is a citation object.

       A `citation?` object contains:

         * entry key (symbol)
         * a formatted reference, such as "(Gray, 2023)" (string), for inclusion
           in the running text, as the citation of the source; note that
           these are all cite-as-parenthetical-note citations, and there's
           no current support for cite-as-noun or cite-as-year versions.
        * a `<li>` element for inclusion in the bibliography (xexpr)"""
       (and (vector? x)
            (eq? (vector-ref x 0) *citation-label*))))))
;; (define (make-citation key ref li-xexpr)
;;   (vector 'citation key ref li-xexpr))
;; (define (citation? b)
;;   (and (vector? b)
;;        (eqv? (vector-ref b 0) 'citation)))
(define (citation-entry citation)
  "`citation-entry : citation? -> entry?` : return the entry? associated with the citation"
  (and (citation? citation)
       (vector-ref citation 1)))
(define (citation-key citation)
  "`citation-key : citation? -> symbol?` : return the entry's citation key"
  (cond ((citation-entry citation) => entry-key)
        (else #f)))
(define (citation-reference citation)
  #"""`citation-reference : citation? -> string?` : returns the in-text reference for the
  citation, such as `(Jones 1999)`"""
  (and (citation? citation)
       (vector-ref citation 2)))
(define (citation-html citation)
  #"""`citation-html c) : citation? -> xexpr?` :
  returns a `<li>` element containing the bibliographic information for the citation."""
  (and (citation? citation)
       (vector-ref citation 3)))
(module-provide make-citation citation? citation-entry citation-key citation-reference citation-html)

;;;; Broader support
;;
;; FIXME: both the preamble, and global strings,
;; are managed using global state.
;; I'd like to fix that, but that's a job for later.
;;
;; Preamble.
(varlet (curlet)
  (let ((*preamble* #f))
    (define (add! s)
      "TO GO: do not use" ;"Append strings to the list retured by GET-PREAMBLE"
      (if (ustring? s)
          (if *preamble*
              (set! *preamble* (ustring-append *preamble* s))
              (set! *preamble* s))
          (beastie-error "Can't add ~s to the preamble" s)))
    (define (get)
      "TO GO: do not use" ;"Return the list of strings created by APPEND-PREAMBLE"
      (or *preamble*
          (make-ustring)))
    (define (clear!)
      "TO GO: do not use" ;; clear the preamble -- for testing and debugging
      (set! *preamble* #f))
    (inlet 'append-preamble! add!
           'get-preamble get
           'clear-preamble*! clear!)))

;; Note: we provide clear-preamble*! for debugging and testing
;; purposes only -- this should disappear when I work out a better way
;; of handling preamble (and strings) in a non-global way.
(module-provide append-preamble! get-preamble clear-preamble*!)

(define (to-ustring fnname s)
   (cond ((ustring? s) s)
         ((string? s) (make-ustring s))
         (else
          (error 'wrong-type-arg
                 "~a: expected string? or ustring?, got ~s" fnname s))))

(define/provide (bib-string-table k)
  #"""`(bib-string-table k)` :
  look up `k` in the `.bib` string table;
  the value may be a `string?` or `ustring?` object
  (case-sensitive)."""
  ;(eprintf "bib-string-table: ~s -> ~s~%" k (bib2-string-table* k))
  (if (eqv? k '*reset-for-tests*)      ;magic reset value
      (bib2-string-table* k #f)
      (bib2-string-table* (to-ustring "bib-string-table" k))))

(define/provide (bib-string-table-set! k v)
  #"""`(bib-string-table-set! k v)` :
  set `k` to the value `v` in the `.bib` string table;
  both key and value may be `string?` or `ustring?` objects
  (case-sensitive).

  Calling `(bib-string-table-set! "jan" "January")`
  is equivalent to finding a `@string{jan="January"}` in a `.bib` file,
  or `MACRO{jan}{"January"}` in a `.bst` file."""
                                        ;(eprintf "bib-string-table-set: ~s -> ~s~%" k v)
  (bib2-string-table* (to-ustring "bib-string-table-set!" k)
                      (to-ustring "bib-string-table-set!" v)))

;;;; Output

;; (listof entry?) -> unspecified
;; Serialise a BibTeX database as JSON
(define/provide (write-bibtex/json! db)
  #"""Write out a parsed BibTeX database, to the current-output-port,
  in JSON syntax.

  The translation to JSON should be fairly obvious,
  but (a) isn't really specified here so may be subject to change, and
  (b) can't necessarily be round-tripped back to BibTeX.  Thus this
  should be regarded as an export format, rather than a transport one
  (the transport format is of course .bib format)."""
  (let ((t (map (lambda (kv)
                  (let ((entry (cdr kv)))
                    `((type	. ,(entry-type entry))
                      (key	. ,(entry-key entry))
                      (fields	. ,(map (λ (fv)
                                          (cons (car fv)
                                                (ustring->string (cdr fv) :display)))
                                        (entry-fields/alist entry))))))
                db)))
    (json-write! t)
    (newline)
    ""))

;; WRITE-BIBTEX/PYTHON! : (listof entry?) -> void
;; Write a BibTeX database as a Python list of dicts, to the current-output-port.
;;
;; The following is cute, and nearly works, but there's no current need for it.
#;(define/provide (write-bibtex/python! db)
  #"""`write-bibtex/python! : (listof entry?) -> unspecified` :
Write out a parsed BibTeX database, to the current-output-port,
in a form which should be straightforwardly readable into Python.
This produces a list of dicts, with the entry's key and type having
same-named keys in the dict.
BibTeX fields with string or number values appear in the obvious way.
Fields such as `month = jan` (ie, where there is a reference to a `@string`),
appear in the output as `"month": b"jan"`."""
  (display "[")
  (for-each (lambda (kv)
              (let ((e (cdr kv)))
                (format #t "{\"key\": \"~a\", \"type\": \"~a\"" (entry-key e) (entry-type e))
                (for-each (lambda (f)
                            (format #t ", \"~a\": ~a" (car f)
                                    (cond ((symbol? (cdr f)) (format #f "b\"~a\"" (cdr f)))
                                          ((bstring? (cdr f)) (bstring->string (cdr f)))
                                          ((string? (cdr f)) (format #f "\"~a\"" (cdr f)))
                                          (else (cdr f))))) ;number
                          (entry-fields/alist e))
                (format #t "},~%")))
            db)
  (format #t "]~%"))

(define/provide (write-bibtex/sexp! db)
  #"""`write-bibtex/sexp! : (listof entry?) -> unspecified` :
  Write out a parsed BibTeX database to the current-output-port, as a sexp.
  The precise format is currently unspecified, and potentially subject to change,
  but should be fairly obvious."""
  (display "(")
  (for-each (λ (kv)
              (let ((e (cdr kv)))
                ;; this isn't just "~a ~a ~s", because that limits how
                ;; many items write outputs, without fiddling with
                ;; (*s7* 'print-length)
                (format #t "(~a ~a" (entry-key e) (entry-type e))
                ;; the following isn't ideal, because symbols (eg,
                ;; 'jan) turn invisibly into strings; but this is
                ;; probably OK for now, since this is (currently)
                ;; an export format rather than a transport format.
                (let ((f/print (map (λ (f)
                                      (cons (car f)
                                            (ustring->string (cdr f) :display)))
                                    (entry-fields/alist e))))
                  ;; sort by field-name, for consistency
                  (for-each (λ (line)
                              (format #t "~%  ~a" line))
                            (sort! f/print (λ (a b) (symbol<? (car a) (car b))))))
                (format #t ")~%")))
            db)
  (printf ")~%"))

;; This function isn't used at present, because the format-name
;; functions below don't do their work using FORMAT, but it might
;; become useful again later.
#;(define (escape-string-for-formatting* s)
  "Escape any ~ characters in the string by doubling them."
  (let loop ((cs (string->list s))
             (res '())
             (escaped? #f))
    (cond ((null? cs)
           (if escaped?
               (list->string (reverse! res))
               s))
          ((char=? (car cs) #\~)
           (loop (cdr cs)
                 `(#\~ #\~ . ,res)
                 #t))
          (else
           (loop (cdr cs)
                 (cons (car cs) res)
                 escaped?)))))

;;;; Useful things for writing (in scheme) bibliography output

 ;; Note: I have changed my mind at least once about what should count
 ;; as falsy: I think that 0 and 0.0 should _not_ count as falsy in a
 ;; bibliographic context, since (although it's a bit of a stretch) we
 ;; might want to print "authors=0" and not have that deleted as being 'false'.
(define/provide (falsy x)
  #"""`(falsy x)` : true if the argument is falsy.
  An object is falsy if it is `#f`, `'()`, `""`, or `#""`."""
  (or (not x)
      (null? x)
      (eqv? x "")
      (and (ustring? x) (= (ustring-length x) 0))
      ;; (eqv? x 0)
      ;; (eqv? x 0.0)
      ))
(define/provide (truthy x)
  "`(truthy x)` : true if `x` is truthy.  Equivalent to `(not (falsy x))`."
  (not (falsy x)))

;; TRUE/LIST*? : any -> boolean?
;; Return false if the argument is falsy, in the sense above.
;; It is also false if the argument is a non-null list which contains an item
;; for which true/list*? is false
;; (ie, it contains (a list which contains) a falsy thing).
;; Otherwise true.

;; Return true if the argument is not a list and is truthy.
;; It is also false if the argument is a list,
;; and not all of its contents are truthy.
;;
;; Deliberately undocumented: this has to be provided because some
;; macros below expand to this, but I don't intend this to be part
;; of the documented interface.
(define/provide (true/list*? x)
  (cond ((falsy x) #f)
        ((list? x)
         ;; x is not null
         (and (true/list*? (car x))
              (or (null? (cdr x))
                  (true/list*? (cdr x)))))
        (else #t)))

(define/provide (maybe-sprintf fmt . fields)
  #"""`(maybe-sprintf "fmt" ...)` :
  Like (sprintf fmt ...), except that if any of the arguments are `falsy`,
  then the whole evaluates to `#f`."""
  (and (true/list*? fields)
       (apply sprintf (cons fmt fields))))

(define/provide (maybe-list . l)
  #"""`(maybe-list ...) :
  Like (list ...), except that if any of the items in the list, or in any sublists,
  are `falsy`, then the whole evaluates to '()."""
  (if (true/list*? l)
      l
      '()))

(define-macro/provide (maybe-list/qq . bits)
  "(maybe-list/qq ...) : like MAYBE-LIST, except that the arguments are expanded inside quasiqote."
  `(apply maybe-list (quasiquote ,bits)))

;; SPRINTF/TRUE : string? any... -> string
(define/provide (sprintf/true fmt . fields)
  #"""`(sprintf/true "fmt" ...)` :
  Like (sprintf fmt ...), except that if any of the arguments are `#f`,
  then the whole evaluates to `""`.

  DEPRECATED: use maybe-sprintf instead."""
  (apply sprintf/true/default `("" ,fmt . ,fields)))
(define/provide (sprintf/true/default default fmt . fields)
  #"""`(sprintf/true/default def "fmt" arg...)` :
  Like (sprintf fmt ...), except that if any of the arguments are `#f`,
  then the whole evaluates to DEF.

  DEPRECATED: use maybe-sprintf instead."""
  (if (true/list*? fields)
      (apply sprintf (cons fmt fields))
      default))

;; MAYBE-LIST : list? -> list?
(define-macro/provide (list/true . args)
  #"""`(list/true ...) :
  Evalates to its arguments if all of those arguments, and their sublists, are non-#f.
  Evaluates to '() otherwise.
  The contents are evaluated inside quasiquote.

  DEPRECATED: use maybe-list instead."""
  `(let ((l (quasiquote ,args)))
     (if (true/list*? l)
         l
         '())))

;; (define/provide (sentence* bits)
;;   (let ((res (sentence** bits)))
;;     (eprintf "(sentence* ~s) -> ~s~%" bits res)
;;     res))
(define/provide (sentence* bits)
  (let loop ((b bits)
             (result '()))
    (cond ((null? b)
           (cond ((null? result) '())
                 ((string? (car result))
                  ;; trim punctuation from (car result)
                  ;; (but if this ends up with an empty string, then go round again)
                  (let ((last-result (string-trim-right (car result) ",;. ")))
                    (if (string=? last-result "")
                        (loop '() (cdr result))
                        (reverse! `(". " ,last-result . ,(cdr result))))))
                 (else (reverse! (cons ". " result)))))
          ((true/list*? (car b))
           (loop (cdr b) (cons (car b) result)))
          (else
           (loop (cdr b) result)))))
(define-macro/provide (sentence . bits)
  #"""(sentence item ...) : expands to (list item ... ". "), wrapping a sequence of items
  in a sentence, typically in an xexpr bibliography entry.

  The items are expanded inside quasiquote.
  Any items which are `#f`, `'()` or `""` are removed.

  If the result is an empty list, then this form evaluates to `'()`.

  If the final item is a string, then any trailing punctuation is stripped
  before the full-stop is added."""
  `(let ((b (quasiquote ,bits)))
     (sentence* b)))

;; WITH-FIELDS-FROM-ENTRY : entry? (symbol? ...) (symbol? ...) expr ...
;;
;; This handles only fields, and doesn't look at local variables at
;; all.  I've changed my mind several times about whether that's the
;; right thing to do.
;;
;; Note that this is a 'local' definition of what is required within
;; the body.  It will presumably overlap with what is specified as
;; required in *bibtex-known-entry-types*
(define-macro/provide (with-fields-from-entry
                          entry required-fields optional-fields expr . exprs)
  #"""(with-fields-from-entry entry (required-field ...) (optional-field ...) body ...) :
  Evaluate the body in a context where the symbols in the `required-field`
  and `optional-field` arguments are defined to have the values of the corresponding
  fields in the entry, or `#f` if absent, before being checked as below.

  Each of the `required-field` elements can be a symbol or a list of symbols.
  In the former case, each of the fields must be present;
  if such a required field is absent, then a warning is issued, and it is defined
  locally to have a non-empty ‘flag value’ (currently the field name uppercased).
  In the latter case, at least one field must be present;
  fields that are absent are defined as `#f`;
  if none are present, then a warning is issued and _one_ of the values is defined
  with the flag value.

  Thus:

      (with-fields-from-entry e
          ((author editor) title)
          (volume number)
        (let ((al (parse-author-list (or author editor))))
          (if volume ... ...)
          ... ))

  If entry `e` has author, title and volume fields, then in the body, `author`,
  `title` and `volume` will have the corresponding field value,
  and `editor` and `number` will be `#f`; there will be no warnings.
  If, on the other hand, `e` has no title field, then a warning will be issued,
  and `title` set to the flag value.
  If _both_ the author and editor fields are absent, then a warning will be issued,
  and one symbol will evaluate to the flag value.
  """
  `(let ,(map (λ (f) ;first define required+optional symbols to field-value or #f
                `(,f (entry-field/crossref ,entry (#_quote ,f))))
              (fold (λ (f knil)         ;list of all symbols
                      (if (list? f)
                          (append f knil)
                          (cons f knil)))
                    '()
                    (append required-fields optional-fields)))
     ,@(map (λ (f) ;for the required fields, check they are defined, and issue warnings
              (if (list? f)
                  `(or ,@f
                       (begin
                         (print-warning "all of ~s are missing in entry ~a"
                                        (#_quote ,f)
                                        (entry-key ,entry))
                         (let-set! (curlet)
                                   (#_quote ,(car f))
                                   ,(ustring-uppercase! (make-ustring (symbol->string (car f)))))))
                  `(or ,f
                       (begin
                         (print-warning "required field '~a' is missing in entry ~a"
                                        (#_quote ,f)
                                        (entry-key ,entry))
                         (let-set! (curlet)
                                   (#_quote ,f)
                                   ,(ustring-uppercase! (make-ustring (symbol->string f))))))))
            required-fields)
     ,expr
     . ,exprs))