skribilo-bugs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#55035: [PATCH] biblio: Replace template interpreter with a macro (a


From: Ludovic Courtès
Subject: bug#55035: [PATCH] biblio: Replace template interpreter with a macro (a "compiler").
Date: Wed, 20 Apr 2022 12:13:25 +0200

This allows us to catch invalid templates at macro-expansion time and is
more efficient.

* src/guile/skribilo/biblio/template.scm (evaluate-bib-entry-template):
Remove.
(define-template-engine, bibliography-template): New macros.
(output-bib-entry-template): Rewrite and remove 'get-field' optional
argument.
(make-bib-entry-template/default, make-bib-entry-template/skribe): Use
'bibliography-template' instead of quasiquote/unquote.
* src/guile/skribilo/package/jfp.scm (le): Likewise.
* src/guile/skribilo/package/lncs.scm (bib-entry-template): Likewise.
* src/guile/skribilo/biblio.scm (&biblio-template-error): Remove.
(handle-biblio-error): Adjust accordingly.
* tests/biblio.test: New file.
* tests/Makefile.am (TESTS): Add it.
---
 src/guile/skribilo/biblio.scm          |  16 +-
 src/guile/skribilo/biblio/template.scm | 304 ++++++++++++-------------
 src/guile/skribilo/package/jfp.scm     |  75 +++---
 src/guile/skribilo/package/lncs.scm    | 111 ++++-----
 tests/Makefile.am                      |   1 +
 tests/biblio.test                      |  88 +++++++
 6 files changed, 336 insertions(+), 259 deletions(-)
 create mode 100644 tests/biblio.test

diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
index 9d83cde..7d95d51 100644
--- a/src/guile/skribilo/biblio.scm
+++ b/src/guile/skribilo/biblio.scm
@@ -55,13 +55,11 @@
            bib-sort-refs/number
 
            ;; error conditions
-           &biblio-error &biblio-entry-error &biblio-template-error
+           &biblio-error &biblio-entry-error
            &biblio-parse-error
-           biblio-error? biblio-entry-error? biblio-template-error?
+           biblio-error? biblio-entry-error?
            biblio-parse-error?
            biblio-entry-error:entry
-           biblio-template-error:expression
-           biblio-template-error:template
            biblio-parse-error:sexp))
 
 ;;; Commentary:
@@ -86,11 +84,6 @@
   biblio-entry-error?
   (entry biblio-entry-error:entry))
 
-(define-condition-type &biblio-template-error &biblio-error
-  biblio-template-error?
-  (expression  biblio-template-error:expression)
-  (template    biblio-template-error:template))
-
 (define-condition-type &biblio-parse-error &biblio-error
   biblio-parse-error?
   (sexp biblio-parse-error:sexp))
@@ -110,11 +103,6 @@
                (format (current-error-port)
                        (G_ "invalid bibliography entry: ~a~%")
                        entry))))
-       ((biblio-template-error? c)
-        (format (current-error-port)
-                 (G_ "invalid bibliography entry template: '~a', in '~a'~%")
-                 (biblio-template-error:expression c)
-                 (biblio-template-error:template c)))
         ((biblio-parse-error? c)
          (format (current-error-port)
                  (G_ "invalid bibliography entry s-exp: '~a'~%")
diff --git a/src/guile/skribilo/biblio/template.scm 
b/src/guile/skribilo/biblio/template.scm
index 96ac4e3..aefb20d 100644
--- a/src/guile/skribilo/biblio/template.scm
+++ b/src/guile/skribilo/biblio/template.scm
@@ -1,7 +1,7 @@
 ;;; template.scm  --  Template system for bibliography entries.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
-;;; Copyright 2006, 2007, 2015, 2018 Ludovic Court�s <ludo@gnu.org>
+;;; Copyright 2006, 2007, 2015, 2018, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;;
 ;;; This file is part of Skribilo.
@@ -32,14 +32,14 @@
 
   #:use-module (skribilo utils syntax)
 
-  #:export (evaluate-bib-entry-template
-           output-bib-entry-template
-           make-bib-entry-template/default
-           make-bib-entry-template/skribe))
+  #:export (bibliography-template
+            output-bib-entry-template
+            make-bib-entry-template/default
+            make-bib-entry-template/skribe))
 
 (skribilo-module-syntax)
 
-;;; Author: Manuel Serrano, Ludovic Court�s
+;;; Author: Manuel Serrano, Ludovic Courtès
 ;;;
 ;;; Commentary:
 ;;;
@@ -57,85 +57,77 @@
 ;;; Outputting a bibliography entry template for a specific entry.
 ;;;
 
-(define (evaluate-bib-entry-template bib template . rest)
-  ;; An interpreter for the bibliography template language.  Overview of the
-  ;; language:
-  ;;
-  ;;  form := (cond-list|special-sexp|string|field-spec)
-  ;;
-  ;;  field-spec   := ("author"|"title"|...)
-  ;;  cond-list    := (form+)
-  ;;  special-sexp := (("if" form form form?)|("or" form*))
-  ;;
-  ;; A `cond-list' gets issued only if all its elements are true.
-
-  (define get-field
-    (if (null? rest)
-        markup-option
-        (car rest)))
-
-  (define (eval-cond-list sexp eval-sexp)
-    (let loop ((sexp   sexp)
-               (result '()))
-      (if (null? sexp)
-          (reverse! result)
-          (let ((head (eval-sexp (car sexp))))
-            (if (not head)
-                #f
-                (loop (cdr sexp)
-                      (cons head result)))))))
-
-  (define (eval-special-sexp sexp eval-sexp)
-    (let ((special (car sexp))
-          (formals (cdr sexp)))
-      (case special
-        ((or)
-         (any eval-sexp formals))
-        ((if)
-         (if (or (> (length formals) 3)
-                 (< (length formals) 2))
-             (raise (condition
-                     (&biblio-template-error (expression sexp)
-                                             (template template)))))
-         (let* ((if-cond (car formals))
-                (if-then (cadr formals))
-                (if-else (if (null? (cddr formals))
-                             #f
-                             (caddr formals)))
-                (result (eval-sexp if-cond)))
-           (if result
-               (eval-sexp if-then)
-               (eval-sexp if-else))))
-        (else
-         (eval-cond-list sexp eval-sexp)))))
-
-  (let loop ((template template))
-    (cond ((symbol? template)
-           (get-field bib template))
-          ((null? template)
-           #f)
-          ((pair? template)
-           (cond ((symbol? (car template))
-                  (eval-special-sexp template loop))
-                 (else
-                  (eval-cond-list template loop))))
-          ((string? template)
-           template)
-          (else
-           (raise (condition
-                   (&biblio-template-error (expression template)
-                                           (template template))))))))
-
-
-(define* (output-bib-entry-template bib engine template
-                                    :optional (get-field markup-option))
+(define-syntax-rule (define-template-engine instantiate literal ...)
+  "Define INSTANTIATE as a macro that, given a template, produces a
+one-argument procedure to instantiate that template given a '&bib-entry'
+node.  LITERAL... is the list of literals, the name of valid markup options."
+  (begin
+    (define-public literal
+      (lambda (s)
+        (syntax-violation 'literal
+                          "template literal used outside of 
'bibliography-template'"
+                          s)))
+    ...
+
+    (define-syntax instantiate-body
+      (lambda (s)
+        (define (literal? id)
+          (any (lambda (l)
+                 (and (identifier? id)
+                      (free-identifier=? id l)))
+               #'(literal ...)))
+
+        (syntax-case s (literal ... or if G_)
+          ((_ n str rest (... ...))
+           (string? (syntax->datum #'str))
+           #'(cons str (instantiate-body n rest (... ...))))
+          ((_ n (G_ str) rest (... ...))
+           (string? (syntax->datum #'str))
+           #'(cons (G_ str) (instantiate-body n rest (... ...))))
+          ((_ n (or options (... ...)) rest (... ...))
+           (every literal? #'(options (... ...)))
+           #'(cons (or (markup-option n 'options) (... ...))
+                   (instantiate-body n rest (... ...))))
+          ((_ n (if cond a b) rest (... ...))
+           (literal? #'cond)
+           #'(cons (if (markup-option n 'cond)
+                       (instantiate-body n a)
+                       (instantiate-body n b))
+                   (instantiate-body n rest (... ...))))
+          ((_ n (lst (... ...)) rest (... ...))
+           #'(append (let ((body (instantiate-body n lst (... ...))))
+                       (if (every ->bool body)
+                           body
+                           '()))
+                     (instantiate-body n rest (... ...))))
+          ((_ n literal rest (... ...))
+           #'(cons (markup-option n 'literal)
+                   (instantiate-body n rest (... ...))))
+          ...
+          ((_ n)
+           #''()))))
+
+    (define-syntax-rule (instantiate body (... ...))
+      (lambda (n)
+        (instantiate-body n body (... ...))))))
+
+;; Define 'bibliography-template' as a macro that builds a procedure to
+;; instantiate a template from a '&bib-entry' node.
+(define-template-engine bibliography-template
+
+  ;; Keywords that may appear in the template.
+  author title url documenturl type
+  journal number volume series booktitle editor
+  school institution address
+  month year day
+  pages chapter publisher)
+
+
+(define* (output-bib-entry-template bib engine template)
   ;; Output the fields of BIB (a bibliography entry) for ENGINE according to
   ;; TEMPLATE.  Example of templates are found below (e.g.,
   ;; `make-bib-entry-template/default').
-  (output (map (lambda (form)
-                 (evaluate-bib-entry-template bib form get-field))
-               template)
-          engine))
+  (output (template bib) engine))
 
 
 ;;;
@@ -147,98 +139,98 @@
 
   (case kind
     ((techreport)
-     `(author ". " (or title url documenturl) ". "
-              ;; TRANSLATORS: The next few msgids are fragments of
-              ;; bibliography items.
-              ,(G_ "Technical Report") " " number
-              (", " institution)
-              (", " address)
-              (", " month) " " year
-              (", pp. " pages) "."))
+     (bibliography-template author ". " (or title url documenturl) ". "
+                            ;; TRANSLATORS: The next few msgids are fragments 
of
+                            ;; bibliography items.
+                            (G_ "Technical Report") " " number
+                            (", " institution)
+                            (", " address)
+                            (", " month) " " year
+                            (", pp. " pages) "."))
     ((article)
-     `(author ". " (or title url documenturl) ". "
-              ,(G_ "In ") journal ", " volume
-              ("(" number ") ")", "
-              (address ", ") month " " year ", "
-              ("pp. " pages) "."))
+     (bibliography-template author ". " (or title url documenturl) ". "
+                            (G_ "In ") journal ", " volume
+                            ("(" number ") ")", "
+                            (address ", ") month " " year ", "
+                            ("pp. " pages) "."))
     ((inproceedings)
-     `(author ". " (or title url documenturl) ". "
-              ,(G_ "In ") booktitle ", "
-              (series ", ")
-              ("(" number ")")
-              ("pp. " pages ", ")
-              (publisher ", ")
-              (month " ") year "."))
+     (bibliography-template author ". " (or title url documenturl) ". "
+                            (G_ "In ") booktitle ", "
+                            (series ", ")
+                            ("(" number ")")
+                            ("pp. " pages ", ")
+                            (publisher ", ")
+                            (month " ") year "."))
     ((book) ;; FIXME:  Title should be in italics
-     '((or author editor)
-              ". " (or title url documenturl) ". "
-              publisher
-              (", " address)
-              (", " month)
-              ", " year
-              (", pp. " pages) "."))
+     (bibliography-template (or author editor)
+                            ". " (or title url documenturl) ". "
+                            publisher
+                            (", " address)
+                            (", " month)
+                            ", " year
+                            (", pp. " pages) "."))
     ((inbook)
-     `(author ". " (or title url documenturl) ". "
-              ,(G_ "In ") booktitle ", " publisher
-              (", " editor " (" ,(G_ "editor") ")")
-              (", " ,(G_ "Chapter ") chapter)
-              (", pp. " pages) ", "
-              (month " ") year "."))
+     (bibliography-template author ". " (or title url documenturl) ". "
+                            (G_ "In ") booktitle ", " publisher
+                            (", " editor " (" (G_ "editor") ")")
+                            (", " (G_ "Chapter ") chapter)
+                            (", pp. " pages) ", "
+                            (month " ") year "."))
     ((phdthesis)
-     `(author ". " (or title url documenturl)
-              ", " ,(G_ "PhD Thesis")
-              (", " (or school institution))
-              (", " address)
-              (", " month)
-              (if month " " ", ") year "."))
+     (bibliography-template author ". " (or title url documenturl)
+                            ", " (G_ "PhD Thesis")
+                            (", " (or school institution))
+                            (", " address)
+                            (", " month)
+                            (if month " " ", ") year "."))
     ((misc)
-     '(author ". " (or title url documenturl) ". "
-              (institution ", ")
-              (publisher ", ")
-              (address ", ")
-              (month " ") year ". "
-              (url ".")))
+     (bibliography-template author ". " (or title url documenturl) ". "
+                            (institution ", ")
+                            (publisher ", ")
+                            (address ", ")
+                            (month " ") year ". "
+                            (url ".")))
     (else
-     '(author ". " (or title url documenturl) ". "
-              (publisher ", ")
-              (address ", ")
-              (month " ") year ", "
-              ("pp. " pages) "."))))
+     (bibliography-template author ". " (or title url documenturl) ". "
+                            (publisher ", ")
+                            (address ", ")
+                            (month " ") year ", "
+                            ("pp. " pages) "."))))
 
 (define (make-bib-entry-template/skribe kind)
   ;; The awful template found by default in Skribe.
   (case kind
     ((techreport)
-     `(author " -- " (or title url documenturl) " -- "
-              ,(G_ "Technical Report") " " number ", " institution ", "
-              address ", " month ", " year ", "
-              ("pp. " pages) "."))
+     (bibliography-template author " -- " (or title url documenturl) " -- "
+                            (G_ "Technical Report") " " number ", " 
institution ", "
+                            address ", " month ", " year ", "
+                            ("pp. " pages) "."))
     ((article)
-     `(author " -- " (or title url documenturl) " -- "
-              journal ", " volume "" ("(" number ")") ", "
-              address ", " month ", " year ", "
-              ("pp. " pages) "."))
+     (bibliography-template author " -- " (or title url documenturl) " -- "
+                            journal ", " volume "" ("(" number ")") ", "
+                            address ", " month ", " year ", "
+                            ("pp. " pages) "."))
     ((inproceedings)
-     `(author " -- " (or title url documenturl) " -- "
-              booktitle ", " series ", " ("(" number ")") ", "
-              address ", " month ", " year ", "
-              ("pp. " pages) "."))
+     (bibliography-template author " -- " (or title url documenturl) " -- "
+                            booktitle ", " series ", " ("(" number ")") ", "
+                            address ", " month ", " year ", "
+                            ("pp. " pages) "."))
     ((book)
-     '(author " -- " (or title url documenturl) " -- "
-              publisher ", " address
-              ", " month ", " year ", " ("pp. " pages) "."))
+     (bibliography-template author " -- " (or title url documenturl) " -- "
+                            publisher ", " address
+                            ", " month ", " year ", " ("pp. " pages) "."))
     ((phdthesis)
-     '(author " -- " (or title url documenturl) " -- " type ", "
-              school ", " address
-              ", " month ", " year"."))
+     (bibliography-template author " -- " (or title url documenturl) " -- " 
type ", "
+                            school ", " address
+                            ", " month ", " year"."))
     ((misc)
-     '(author " -- " (or title url documenturl) " -- "
-              publisher ", " address
-              ", " month ", " year"."))
+     (bibliography-template author " -- " (or title url documenturl) " -- "
+                            publisher ", " address
+                            ", " month ", " year"."))
     (else
-     '(author " -- " (or title url documenturl) " -- "
-              publisher ", " address
-              ", " month ", " year ", " ("pp. " pages) "."))))
+     (bibliography-template author " -- " (or title url documenturl) " -- "
+                            publisher ", " address
+                            ", " month ", " year ", " ("pp. " pages) "."))))
 
 
 ;;; arch-tag: 5931579f-b606-442d-9a45-6047c94da5a2
diff --git a/src/guile/skribilo/package/jfp.scm 
b/src/guile/skribilo/package/jfp.scm
index 140ff4c..fa6fcc6 100644
--- a/src/guile/skribilo/package/jfp.scm
+++ b/src/guile/skribilo/package/jfp.scm
@@ -1,7 +1,7 @@
 ;;; jfp.scm  --  The Skribe style for JFP articles.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
-;;; Copyright 2007, 2020  Ludovic Courtès <ludo@chbouib.org>
+;;; Copyright 2007, 2020, 2022 Ludovic Courtès <ludo@chbouib.org>
 ;;;
 ;;;
 ;;; This file is part of Skribilo.
@@ -26,9 +26,9 @@
   #:autoload   (skribilo output)          (output)
   #:autoload   (skribilo evaluator)       (evaluate-document)
   #:use-module (skribilo lib)
-  #:autoload   (skribilo biblio template) (output-bib-entry-template)
+  #:use-module (skribilo biblio template)
   #:autoload   (skribilo utils keywords)  (the-body)
-  #:use-module (skribilo package base)
+  #:use-module ((skribilo package base) #:hide (author))
   #:use-module (srfi srfi-1)
 
   #:use-module (skribilo utils syntax)
@@ -228,37 +228,44 @@
                 (output-bib-entry-template n e
 
                  (case (markup-option n 'kind)
-                    ((techreport)
-                     `(author (" (" year ")") " " (or title url) ". " 
-                              number ", " institution ", "
-                              address ", " month ", "
-                              ("pp. " pages) "."))
-                    ((article)
-                     `(author (" (" year ")") " " (or title url) ". "
-                              journal ", " volume ", " ("(" number ")") ", "
-                              address ", " month ", " 
-                              ("pp. " pages) "."))
-                    ((inproceedings)
-                     `(author (" (" year ")") " " (or title url) ". " 
-                              book(or title url) ", " series ", " ("(" number 
")") ", "
-                              address ", " month ", " 
-                              ("pp. " pages) "."))
-                    ((book)
-                     '(author (" (" year ")") " " (or title url) ". " 
-                              publisher ", " address
-                              ", " month ", " ("pp. " pages) "."))
-                    ((phdthesis)
-                     '(author (" (" year ")") " " (or title url) ". " type ", 
" 
-                              school ", " address
-                              ", " month "."))
-                    ((misc)
-                     '(author (" (" year ")") " " (or title url) ". "
-                              publisher ", " address
-                              ", " month "."))
-                    (else
-                     '(author (" (" year ")") " " (or title url) ". "
-                              publisher ", " address
-                              ", " month ", " ("pp. " pages) "."))))))
+                   ((techreport)
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". "
+                     number ", " institution ", "
+                     address ", " month ", "
+                     ("pp. " pages) "."))
+                   ((article)
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". "
+                     journal ", " volume ", " ("(" number ")") ", "
+                     address ", " month ", "
+                     ("pp. " pages) "."))
+                   ((inproceedings)
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". "
+                     booktitle (or title url) ", " series ", " ("(" number 
")") ", "
+                     address ", " month ", "
+                     ("pp. " pages) "."))
+                   ((book)
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". "
+                     publisher ", " address
+                     ", " month ", " ("pp. " pages) "."))
+                   ((phdthesis)
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". " type ", "
+                     school ", " address
+                     ", " month "."))
+                   ((misc)
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". "
+                     publisher ", " address
+                     ", " month "."))
+                   (else
+                    (bibliography-template
+                      author (" (" year ")") " " (or title url) ". "
+                     publisher ", " address
+                     ", " month ", " ("pp. " pages) "."))))))
    ;; abstract
    (markup-writer 'jfp-abstract le
        :options '(postscript)
diff --git a/src/guile/skribilo/package/lncs.scm 
b/src/guile/skribilo/package/lncs.scm
index 2e6bb21..bf6b7cb 100644
--- a/src/guile/skribilo/package/lncs.scm
+++ b/src/guile/skribilo/package/lncs.scm
@@ -1,7 +1,7 @@
 ;;; lncs.scm  --  The Skribilo style for LNCS articles.
 ;;;
 ;;; Copyright 2003, 2004  Manuel Serrano
-;;; Copyright 2007, 2015, 2018, 2020  Ludovic Courtès <ludo@gnu.org>
+;;; Copyright 2007, 2015, 2018, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;;
 ;;; This file is part of Skribilo.
@@ -24,10 +24,11 @@
   #:use-module (skribilo engine)
   #:use-module (skribilo writer)
   #:autoload   (skribilo output)         (output)
-  #:use-module (skribilo package base)
+  #:use-module ((skribilo package base) #:hide (author))
   #:autoload   (skribilo utils keywords) (the-options the-body)
-  #:autoload   (skribilo biblio template)(output-bib-entry-template
-                                         make-bib-entry-template/default)
+  #:use-module ((skribilo biblio template) #:hide (chapter))
+  #:use-module ((skribilo biblio template)
+                #:select ((chapter . biblio:chapter)))
   #:autoload   (skribilo biblio author)  (bib-sort/first-author-last-name
                                           
abbreviate-author-first-names/family-first
                                           abbreviate-first-names)
@@ -211,64 +212,64 @@
   ;; Return the LNCS bibliography entry template for KIND.
   (case kind
     ((techreport)
-     `(author ": " (or title url documenturl) ". "
-              ;; TRANSLATORS: The next few msgids are fragments of
-              ;; bibliography items.
-              ,(G_ "Technical Report") " " number
-              (", " institution)
-              (", " address)
-              (", " pages)
-              (" (" year ")")))
+     (bibliography-template author ": " (or title url documenturl) ". "
+                            ;; TRANSLATORS: The next few msgids are fragments
+                            ;; of bibliography items.
+                            (G_ "Technical Report") " " number
+                            (", " institution)
+                            (", " address)
+                            (", " pages)
+                            (" (" year ")")))
     ((article)
-     `(author ": " (or title url documenturl) ". "
-              ,(G_ "In: ") journal ", " volume
-              ("(" number ")") ", "
-              (address ", ")
-              ("pp. " pages) (" (" year ")")))
+     (bibliography-template author ": " (or title url documenturl) ". "
+                            (G_ "In: ") journal ", " volume
+                            ("(" number ")") ", "
+                            (address ", ")
+                            ("pp. " pages) (" (" year ")")))
     ((inproceedings)
-     '(author ": " (or title url documenturl) ". "
-              ,(G_ "In: ") booktitle ", "
-              (series)
-              ("(" number "), ")
-              (publisher ", ")
-              ("pp. " pages)
-              (" (" year ")")))
+     (bibliography-template author ": " (or title url documenturl) ". "
+                            (G_ "In: ") booktitle ", "
+                            (series)
+                            ("(" number "), ")
+                            (publisher ", ")
+                            ("pp. " pages)
+                            (" (" year ")")))
     ((book)
-     '((or author editor) ": "
-       (or title url documenturl) ". "
-       publisher
-       (", " address)
-       (", " month)
-       ", " year
-       (", pp. " pages)))
+     (bibliography-template (or author editor) ": "
+                            (or title url documenturl) ". "
+                            publisher
+                            (", " address)
+                            (", " month)
+                            ", " year
+                            (", pp. " pages)))
     ((inbook)
-     `(author ": " (or title url documenturl) ". "
-              ,(G_ "In: ") booktitle ", " publisher
-              (", " editor " (" ,(G_ "editor") ")")
-              (", " ,(G_ "Chapter ") chapter)
-              (", pp. " pages)
-              (" (" year ")")))
+     (bibliography-template author ": " (or title url documenturl) ". "
+                            (G_ "In: ") booktitle ", " publisher
+                            (", " editor " (" (G_ "editor") ")")
+                            (", " (G_ "Chapter ") biblio:chapter)
+                            (", pp. " pages)
+                            (" (" year ")")))
     ((phdthesis)
-     `(author ": " (or title url documenturl)
-              ", " ,(G_ "PhD Thesis")
-              (", " (or school institution))
-              (", " address)
-              (", " month)
-              (if month " " ", ") year))
+     (bibliography-template author ": " (or title url documenturl)
+                            ", " (G_ "PhD Thesis")
+                            (", " (or school institution))
+                            (", " address)
+                            (", " month)
+                            (if month " " ", ") year))
     ((misc)
-     '(author ": " (or title url documenturl) ". "
-              (institution ", ")
-              (publisher ", ")
-              (address ", ")
-              (month " ") ("(" year ")")
-              (" " url)))
+     (bibliography-template author ": " (or title url documenturl) ". "
+                            (institution ", ")
+                            (publisher ", ")
+                            (address ", ")
+                            (month " ") ("(" year ")")
+                            (" " url)))
     (else
-     '(author ": " (or title url documenturl) ". "
-              (publisher ", ")
-              (address ", ")
-              (month " ")
-              (", pp. " pages)
-              (" (" year ")")))))
+     (bibliography-template author ": " (or title url documenturl) ". "
+                            (publisher ", ")
+                            (address ", ")
+                            (month " ")
+                            (", pp. " pages)
+                            (" (" year ")")))))
 
 
 ;;;
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 8ba7637..a423234 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -11,6 +11,7 @@ TEST_LOG_DRIVER =                                             
        \
 
 TESTS =                                                \
   ast.test                                     \
+  biblio.test                                  \
   resolve.test                                 \
   engines/info.test                            \
   location.test
diff --git a/tests/biblio.test b/tests/biblio.test
new file mode 100644
index 0000000..954d964
--- /dev/null
+++ b/tests/biblio.test
@@ -0,0 +1,88 @@
+;;; Exercise the `biblio' routines.                  -*- Scheme -*-
+;;;
+;;; Copyright (C) 2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Skribilo.
+;;;
+;;; Skribilo is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Skribilo is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests biblio)
+  #:use-module ((skribilo reader) #:select (*document-reader*))
+  #:use-module (skribilo ast)
+  #:use-module (skribilo biblio)
+  #:use-module (skribilo biblio template)
+  #:use-module (srfi srfi-64))
+
+(define sbib
+  '(article
+    scheme:r5rs
+    (title "The Revised5 Report on the Algorithmic Language Scheme")
+    (author "Richard Kelsey, William D. Clinger, Jonathan Rees")
+    (journal "Higher-Order and Symbolic Computation")
+    (volume "11")
+    (number "1")
+    (month "Sep")
+    (year "1998")
+    (url "http://kaolin.unice.fr/Bigloo/doc/r5rs.html";)))
+
+(define table
+  (make-bib-table 'table))
+
+
+(test-begin "biblio")
+
+(test-equal "parse-bib"
+  "The Revised5 Report on the Algorithmic Language Scheme"
+  (begin
+    (call-with-input-string (object->string sbib)
+      (lambda (port)
+        (parameterize ((*document-reader* read))
+          (parse-bib table port))))
+    (and (bib-table? table)
+         (let ((entry (resolve-bib table 'scheme:r5rs)))
+           (and (is-markup? entry '&bib-entry)
+                (markup-body (markup-option entry 'title)))))))
+
+(test-equal "bibliography-template, simple"
+  (let ((entry (resolve-bib table 'scheme:r5rs)))
+    (list "A: " (markup-option entry 'author)
+          "T: " (markup-option entry 'title)
+          "Y: " (markup-option entry 'year)))
+  (let ((template (bibliography-template "A: " author
+                                         "T: " title
+                                         "Y: " year)))
+    (template (resolve-bib table 'scheme:r5rs))))
+
+(test-equal "bibliography-template, conditionals"
+  (let ((entry (resolve-bib table 'scheme:r5rs)))
+    (list "A: " (markup-option entry 'author)
+          "T: " (markup-option entry 'title)
+          "Y: " (list (markup-option entry 'year))
+          "B: " '("no")))
+  (let ((template (bibliography-template "A: " (or editor author)
+                                         "T: " (or booktitle title)
+                                         "Y: " (if year year "N")
+                                         "B: " (if booktitle "yes" "no"))))
+    (template (resolve-bib table 'scheme:r5rs))))
+
+(test-equal "bibliography-template, tricky things"
+  (let ((entry (resolve-bib table 'scheme:r5rs)))
+    (list "A: " (markup-option entry 'author)
+          "Y: " (markup-option entry 'year) "!"))
+  (let ((template (bibliography-template ("A: " author)
+                                         ("T: " booktitle "+" title)
+                                         ("Y: " year "!"))))
+    (template (resolve-bib table 'scheme:r5rs))))
+
+(test-end "biblio")

base-commit: 3746030f437db70c8ede10f7f063fac2a8d51248
-- 
2.35.1






reply via email to

[Prev in Thread] Current Thread [Next in Thread]