diff options
author | Ludovic Courtès | 2022-04-19 23:42:26 +0200 |
---|---|---|
committer | Ludovic Courtès | 2022-05-05 22:23:23 +0200 |
commit | 424bef0d0aac2a5a8607cf9f76a6def5ee0ca183 (patch) | |
tree | 45a682403c6bfe78725214de837ae4be2a1b91fe /src | |
parent | 621eb1945aec8f26f5aee4bdf896f2434e145182 (diff) | |
download | skribilo-424bef0d0aac2a5a8607cf9f76a6def5ee0ca183.tar.gz skribilo-424bef0d0aac2a5a8607cf9f76a6def5ee0ca183.tar.lz skribilo-424bef0d0aac2a5a8607cf9f76a6def5ee0ca183.zip |
biblio: Replace template interpreter with a macro (a "compiler").
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/guile/skribilo/biblio.scm | 16 | ||||
-rw-r--r-- | src/guile/skribilo/biblio/template.scm | 304 | ||||
-rw-r--r-- | src/guile/skribilo/package/jfp.scm | 75 | ||||
-rw-r--r-- | src/guile/skribilo/package/lncs.scm | 111 |
4 files changed, 247 insertions, 259 deletions
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..d6379cd 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_) + ((_ node str rest (... ...)) + (string? (syntax->datum #'str)) + #'(cons str (instantiate-body node rest (... ...)))) + ((_ node (G_ str) rest (... ...)) + (string? (syntax->datum #'str)) + #'(cons (G_ str) (instantiate-body node rest (... ...)))) + ((_ node (or options (... ...)) rest (... ...)) + (every literal? #'(options (... ...))) + #'(cons (or (markup-option node 'options) (... ...)) + (instantiate-body node rest (... ...)))) + ((_ node (if cond a b) rest (... ...)) + (literal? #'cond) + #'(cons (if (markup-option node 'cond) + (instantiate-body node a) + (instantiate-body node b)) + (instantiate-body node rest (... ...)))) + ((_ node (lst (... ...)) rest (... ...)) + #'(append (let ((body (instantiate-body node lst (... ...)))) + (if (every ->bool body) + body + '())) + (instantiate-body node rest (... ...)))) + ((_ node literal rest (... ...)) + #'(cons (markup-option node 'literal) + (instantiate-body node rest (... ...)))) + ... + ((_ node) + #''())))) + + (define-syntax-rule (instantiate body (... ...)) + (lambda (node) + (instantiate-body node 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 ")"))))) ;;; |