406 lines
18 KiB
EmacsLisp
406 lines
18 KiB
EmacsLisp
;; citeproc-formatters.el --- output formatters -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2017-2021 András Simonyi
|
||
|
||
;; Author: András Simonyi <andras.simonyi@gmail.com>
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program 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 General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;; This file is not part of GNU Emacs.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Provides a general framework for defining citeproc-el output formatters, and,
|
||
;; using this framework, defines formatters for the formats `raw' (the rich-text
|
||
;; internal representation), `plain' (plain-text), `html', `org' and `latex'.
|
||
;; Further output formatters can easily be added.
|
||
|
||
;;; Code:
|
||
|
||
(require 'let-alist)
|
||
(require 'subr-x)
|
||
(require 's)
|
||
(require 'cl-lib)
|
||
|
||
(require 'citeproc-s)
|
||
(require 'citeproc-rt)
|
||
|
||
(cl-defstruct (citeproc-formatter (:constructor citeproc-formatter-create))
|
||
"Output formatter struct with slots RT, CITE, BIB-ITEM and BIB.
|
||
RT is a one-argument function mapping a rich-text to its
|
||
formatted version,
|
||
CITE is a one-argument function mapping the output of RT for a
|
||
citation rich-text to a fully formatted citation,
|
||
BIB-ITEM is a two-argument function mapping the output of RT for
|
||
a bibliography-item rich-text and a BIB-FORMAT alist (see
|
||
below) to a fully formatted bibliography item,
|
||
BIB is a two-argument function mapping a list of formatted
|
||
bibliography items and a FORMATTING-PARAMETERS alist (see
|
||
`citeproc-render-bib' for details) to a fully formatted
|
||
bibliography,
|
||
NO-EXTERNAL-LINKS is non-nil if the formatter doesn't support
|
||
external linking."
|
||
rt (cite #'identity) (bib-item (lambda (x _) x))
|
||
(bib (lambda (x _) (mapconcat #'identity x "\n\n")))
|
||
(no-external-links nil))
|
||
|
||
(defun citeproc-formatter-fun-create (fmt-alist)
|
||
"Return a rich-text formatter function based on FMT-ALIST.
|
||
FMT-ALIST is an alist with some or all of the following symbols
|
||
as keys:
|
||
- `unformatted',
|
||
- `font-style-italic', `font-style-oblique', `font-style-normal',
|
||
- `font-variant-small-caps', `font-variant-normal',
|
||
- `font-weight-bold', `font-weight-light', `font-weight-normal',
|
||
- `text-decoration-underline', `text-decoration-normal',
|
||
- `vertical-align-sub', `vertical-align-sup', `vertical-align-baseline',
|
||
- `display-block', `display-left-margin', `display-right-inline',
|
||
`display-indent',
|
||
- `href',
|
||
- `cited-item-no', `bib-item-no'.
|
||
|
||
With the exceptions listed below the values should be
|
||
one-argument formatting functions that format the input string
|
||
according to the attribute-value pair specified by the key.
|
||
|
||
The exceptions are the keys
|
||
`unformatted', for which the value should be a one-argument
|
||
function converting unformatted text into the required
|
||
format (e.g., by escaping);
|
||
`href', here the value should be a two-argument function
|
||
mapping the first argument as anchor text and the second as
|
||
target URI to a hyperlink representation; and
|
||
`cited-item-no' and `bib-item-no' whose associated values
|
||
should be two-argument functions, which are called with the
|
||
already formatted cites/bibliography item text and the number of
|
||
the bibliography item as a string."
|
||
(cl-labels
|
||
((rt-fmt
|
||
(rt)
|
||
(pcase rt
|
||
((pred stringp) (funcall (alist-get 'unformatted fmt-alist) rt))
|
||
((pred consp)
|
||
(let ((attrs (car rt))
|
||
(result (mapconcat #'rt-fmt (cdr rt) "")))
|
||
(dolist (attr attrs)
|
||
(let ((key (car attr)))
|
||
(if (memq key '(href cited-item-no bib-item-no))
|
||
(when-let ((fmt-fun (alist-get key fmt-alist)))
|
||
(setq result (funcall fmt-fun result (cdr attr))))
|
||
(when-let
|
||
((fmt-fun
|
||
(alist-get
|
||
(pcase attr
|
||
('(font-style . "italic") 'font-style-italic)
|
||
('(font-weight . "bold") 'font-weight-bold)
|
||
('(display . "indent") 'display-indent)
|
||
('(display . "left-margin") 'display-left-margin)
|
||
('(display . "right-inline") 'display-right-inline)
|
||
('(display . "block") 'display-block)
|
||
('(vertical-align . "sup") 'vertical-align-sup)
|
||
('(vertical-align . "baseline") 'vertical-align-baseline)
|
||
('(font-variant . "small-caps") 'font-variant-small-caps)
|
||
('(text-decoration . "underline") 'text-decoration-underline)
|
||
('(font-style . "oblique") 'font-style-oblique)
|
||
('(font-style . "normal") 'font-style-normal)
|
||
('(font-variant . "normal") 'font-variant-normal)
|
||
('(font-weight . "light") 'font-weight-light)
|
||
('(font-weight . "normal") 'font-weight-normal)
|
||
('(text-decoration . "normal") 'text-decoration-normal)
|
||
('(vertical-align . "sub") 'vertical-align-sub))
|
||
fmt-alist)))
|
||
(setq result (funcall fmt-fun result))))))
|
||
result))
|
||
(_ rt))))
|
||
#'rt-fmt))
|
||
|
||
;;;; Specific formatters
|
||
|
||
;; Org
|
||
|
||
(defun citeproc-fmt--org-link (anchor target)
|
||
"Return an Org link with ANCHOR and TARGET.
|
||
If ANCHOR is string= to TARGET then return ANCHOR."
|
||
(if (string= anchor target)
|
||
anchor
|
||
(concat "[[" target "][" anchor "]]")))
|
||
|
||
(defconst citeproc-fmt--org-alist
|
||
`((unformatted . identity)
|
||
(href . ,#'citeproc-fmt--org-link)
|
||
(cited-item-no . ,(lambda (x y) (concat "[[citeproc_bib_item_" y "][" x "]]")))
|
||
(bib-item-no . ,(lambda (x y) (concat "<<citeproc_bib_item_" y ">>" x)))
|
||
;; Warning: The next four formatter lines put protective zero-width spaces
|
||
;; around the Org format characters ('/' etc.).
|
||
(font-style-italic . ,(lambda (x) (concat "/" x "/")))
|
||
(font-style-oblique . ,(lambda (x) (concat "/" x "/")))
|
||
(font-weight-bold . ,(lambda (x) (concat "*" x "*")))
|
||
(text-decoration-underline . ,(lambda (x) (concat "_" x "_")))
|
||
;; End of zero-width space protected formatters.
|
||
(font-variant-small-caps . ,(lambda (x) (upcase x)))
|
||
(vertical-align-sub . ,(lambda (x) (concat "_{" x "}")))
|
||
(vertical-align-sup . ,(lambda (x) (concat "^{" x "}")))
|
||
(display-left-margin . ,(lambda (x) (concat x " ")))))
|
||
|
||
(defvar citeproc-fmt--org-format-rt-1
|
||
(citeproc-formatter-fun-create citeproc-fmt--org-alist)
|
||
"Recursive rich-text Org formatter.
|
||
Doesn't do finalization by removing zero-width spaces.")
|
||
|
||
(defun citeproc-fmt--org-format-rt (rt)
|
||
"Convert rich-text RT into Org format.
|
||
Performs finalization by removing unnecessary zero-width spaces."
|
||
(let ((result (funcall citeproc-fmt--org-format-rt-1 rt)))
|
||
(when (> (length result) 2)
|
||
;; First we remove z-w spaces around spaces and before punctuation.
|
||
(setq result (citeproc-s-replace-all-seq
|
||
result '((" " . " ") (" " . " ") ("," . ",") (";" . ";")
|
||
(":" . ":") ("." . "."))))
|
||
;; Starting and ending z-w spaces are also removed, but not before an asterisk
|
||
;; to avoid creating an Org heading.
|
||
(when (and (= (aref result 0) 8203)
|
||
(not (= (aref result 1) ?*)))
|
||
(setq result (substring result 1)))
|
||
(when (= (aref result (- (length result) 1)) 8203)
|
||
(setq result (substring result 0 -1)))
|
||
;; Prepend a zero width no-break space when the text starts with
|
||
;; superscript to make Org parse it correctly.
|
||
;; NOTE: This is a workaround, ideally should be fixed in Org.
|
||
(when (= (aref result 0) ?^)
|
||
(setq result (concat "" result))))
|
||
result))
|
||
|
||
;; HTML
|
||
|
||
(defun citeproc-fmt--xml-escape (s)
|
||
"Return the xml-escaped version of string S.
|
||
Only '&', '<' and '>' are escaped to keep compatibility with the
|
||
CSL tests."
|
||
(citeproc-s-replace-all-seq s '(("&" . "&") ("<" . "<") (">" . ">"))))
|
||
|
||
(defconst citeproc-fmt--html-alist
|
||
`((unformatted . citeproc-fmt--xml-escape)
|
||
(href . ,(lambda (x y) (concat "<a href=\"" y "\">" x "</a>")))
|
||
(cited-item-no . ,(lambda (x y) (concat "<a href=\"#citeproc_bib_item_" y "\">"
|
||
x "</a>")))
|
||
(bib-item-no . ,(lambda (x y) (concat "<a id=\"citeproc_bib_item_" y "\"></a>"
|
||
x)))
|
||
(font-style-italic . ,(lambda (x) (concat "<i>" x "</i>")))
|
||
(font-style-oblique . ,(lambda (x)
|
||
(concat "<span style=\"font-style:oblique;\"" x "</span>")))
|
||
(font-variant-small-caps . ,(lambda (x)
|
||
(concat
|
||
"<span style=\"font-variant:small-caps;\">" x "</span>")))
|
||
(font-weight-bold . ,(lambda (x) (concat "<b>" x "</b>")))
|
||
(text-decoration-underline .
|
||
,(lambda (x)
|
||
(concat
|
||
"<span style=\"text-decoration:underline;\">" x "</span>")))
|
||
(vertical-align-sub . ,(lambda (x) (concat "<sub>" x "</sub>")))
|
||
(vertical-align-sup . ,(lambda (x) (concat "<sup>" x "</sup>")))
|
||
(vertical-align-baseline . ,(lambda (x) (concat "<span style=\"baseline\">" x "</span>")))
|
||
(display-left-margin . ,(lambda (x) (concat "\n <div class=\"csl-left-margin\">"
|
||
x "</div>")))
|
||
(display-right-inline . ,(lambda (x) (concat "<div class=\"csl-right-inline\">"
|
||
x "</div>\n ")))
|
||
(display-block . ,(lambda (x) (concat "\n\n <div class=\"csl-block\">"
|
||
x "</div>\n")))
|
||
(display-indent . ,(lambda (x) (concat "<div class=\"csl-indent\">" x "</div>\n ")))))
|
||
|
||
(defconst citeproc-fmt--csl-test-alist
|
||
`((unformatted . citeproc-fmt--xml-escape)
|
||
(cited-item-no . ,(lambda (x y) (concat "<a href=\"#citeproc_bib_item_" y "\">"
|
||
x "</a>")))
|
||
(bib-item-no . ,(lambda (x y) (concat "<a id=\"citeproc_bib_item_" y "\"></a>"
|
||
x)))
|
||
(font-style-italic . ,(lambda (x) (concat "<i>" x "</i>")))
|
||
(font-style-oblique . ,(lambda (x)
|
||
(concat "<span style=\"font-style:oblique;\"" x "</span>")))
|
||
(font-variant-small-caps . ,(lambda (x)
|
||
(concat
|
||
"<span style=\"font-variant:small-caps;\">" x "</span>")))
|
||
(font-weight-bold . ,(lambda (x) (concat "<b>" x "</b>")))
|
||
(text-decoration-underline .
|
||
,(lambda (x)
|
||
(concat
|
||
"<span style=\"text-decoration:underline;\">" x "</span>")))
|
||
(vertical-align-sub . ,(lambda (x) (concat "<sub>" x "</sub>")))
|
||
(vertical-align-sup . ,(lambda (x) (concat "<sup>" x "</sup>")))
|
||
(vertical-align-baseline . ,(lambda (x) (concat "<span style=\"baseline\">" x "</span>")))
|
||
(display-left-margin . ,(lambda (x) (concat "\n <div class=\"csl-left-margin\">"
|
||
x "</div>")))
|
||
(display-right-inline . ,(lambda (x) (concat "<div class=\"csl-right-inline\">"
|
||
x "</div>\n ")))
|
||
(display-block . ,(lambda (x) (concat "\n\n <div class=\"csl-block\">"
|
||
x "</div>\n")))
|
||
(display-indent . ,(lambda (x) (concat "<div class=\"csl-indent\">" x "</div>\n ")))))
|
||
|
||
(defun citeproc-fmt--html-bib-formatter (items _bib-format)
|
||
"Return a html bibliography from already formatted ITEMS."
|
||
(concat "<div class=\"csl-bib-body\">\n"
|
||
(mapconcat (lambda (i)
|
||
(concat " <div class=\"csl-entry\">" i "</div>\n"))
|
||
items
|
||
"")
|
||
"</div>"))
|
||
|
||
;; LaTeX
|
||
|
||
(defconst citeproc-fmt--latex-esc-regex
|
||
(regexp-opt '("_" "&" "#" "%" "$"))
|
||
"Regular expression matching characters to be escaped in LaTeX output.")
|
||
|
||
(defun citeproc-fmt--latex-escape (s)
|
||
"Return the LaTeX-escaped version of string S."
|
||
(replace-regexp-in-string citeproc-fmt--latex-esc-regex "\\\\\\&" s))
|
||
|
||
(defconst citeproc-fmt--latex-uri-esc-regex
|
||
(regexp-opt '("#" "%"))
|
||
"Regular expression matching characters to be escaped in URIs for LaTeX output.")
|
||
|
||
(defun citeproc-fmt--latex-href (text uri)
|
||
(let ((escaped-uri (replace-regexp-in-string
|
||
citeproc-fmt--latex-uri-esc-regex "\\\\\\&" uri)))
|
||
(if (string-prefix-p "http" text)
|
||
(concat "\\url{" escaped-uri "}")
|
||
(concat "\\href{" escaped-uri "}{" text "}"))))
|
||
|
||
(defconst citeproc-fmt--latex-alist
|
||
`((unformatted . ,#'citeproc-fmt--latex-escape)
|
||
(href . ,#'citeproc-fmt--latex-href)
|
||
(font-style-italic . ,(lambda (x) (concat "\\textit{" x "}")))
|
||
(font-weight-bold . ,(lambda (x) (concat "\\textbf{" x "}")))
|
||
(cited-item-no . ,(lambda (x y) (concat "\\citeprocitem{" y "}{" x "}")))
|
||
(bib-item-no . ,(lambda (x y) (concat "\\hypertarget{citeproc_bib_item_" y "}{"
|
||
x "}")))
|
||
(font-variant-small-caps . ,(lambda (x) (concat "\\textsc{" x "}")))
|
||
(text-decoration-underline . ,(lambda (x) (concat "\\underline{" x "}")))
|
||
(vertical-align-sup . ,(lambda (x) (concat "\\textsuperscript{" x "}")))
|
||
(display-left-margin . ,(lambda (x) (concat x " ")))
|
||
(vertical-align-sub . ,(lambda (x) (concat "\\textsubscript{" x "}")))
|
||
(font-style-oblique . ,(lambda (x) (concat "\\textsl{" x "}")))))
|
||
|
||
;; Org-LaTeX
|
||
|
||
(defconst citeproc-fmt--org-latex-alist
|
||
`((unformatted . ,#'citeproc-fmt--latex-escape)
|
||
(href . ,#'citeproc-fmt--latex-href)
|
||
(font-style-italic . ,(lambda (x) (concat "\\textit{" x "}")))
|
||
(font-weight-bold . ,(lambda (x) (concat "\\textbf{" x "}")))
|
||
(cited-item-no . ,(lambda (x y) (concat "\\cslcitation{" y "}{" x "}")))
|
||
(bib-item-no . ,(lambda (x y) (concat "\\cslbibitem{" y "}{" x "}")))
|
||
(font-variant-small-caps . ,(lambda (x) (concat "\\textsc{" x "}")))
|
||
(text-decoration-underline . ,(lambda (x) (concat "\\underline{" x "}")))
|
||
(vertical-align-sup . ,(lambda (x) (concat "\\textsuperscript{" x "}")))
|
||
(display-left-margin . ,(lambda (x) (concat "\\cslleftmargin{" x "}")))
|
||
(display-right-inline . ,(lambda (x) (concat "\\cslrightinline{" x "}")))
|
||
(display-block . ,(lambda (x) (concat "\\cslblock{" x "}")))
|
||
(display-indent . ,(lambda (x) (concat "\\cslindent{" x "}")))
|
||
(vertical-align-sub . ,(lambda (x) (concat "\\textsubscript{" x "}")))
|
||
(font-style-oblique . ,(lambda (x) (concat "\\textsl{" x "}")))))
|
||
|
||
(defun citeproc-fmt--org-latex-bib-formatter (items bib-format)
|
||
"Return an Org LaTeX bibliography of ITEMS formatted in BIB-FORMAT."
|
||
(let-alist bib-format
|
||
(let ((hanging-indent (if .hanging-indent "1" "0"))
|
||
(entry-spacing (if (and .entry-spacing (<= 1 .entry-spacing))
|
||
(number-to-string (- .entry-spacing 1))
|
||
"0")))
|
||
(concat "\\begin{cslbibliography}{" hanging-indent "}{" entry-spacing "}\n"
|
||
(mapconcat #'identity items "\n\n")
|
||
"\n\n\\end{cslbibliography}\n"))))
|
||
|
||
;; Org-ODT
|
||
|
||
(defconst citeproc-fmt--org-odt-alist
|
||
`((unformatted . citeproc-fmt--xml-escape)
|
||
(href . ,(lambda (x y) (concat "<text:a xlink:type=\"simple\" xlink:href=\""
|
||
y "\">" x "</text:a>")))
|
||
(cited-item-no
|
||
. ,(lambda (x y) (concat "<text:a xlink:type=\"simple\" xlink:href=\"#citeproc_bib_item_"
|
||
y "\">" x "</text:a>")))
|
||
(bib-item-no
|
||
. ,(lambda (x y)
|
||
(concat "<text:bookmark-start text:name=\"OrgXref.citeproc_bib_item_" y "\"/>"
|
||
"<text:bookmark text:name=\"citeproc_bib_item_" y "\"/>"
|
||
"<text:bookmark-end text:name=\"OrgXref.citeproc_bib_item_" y "\"/>" x)))
|
||
(font-style-italic
|
||
. ,(lambda (x) (concat "<text:span text:style-name=\"Emphasis\">" x "</text:span>")))
|
||
(font-style-oblique
|
||
. ,(lambda (x) (concat "<text:span text:style-name=\"Emphasis\">" x "</text:span>")))
|
||
;; NOTE: small caps support requires the availability of the OrgSmallcaps ODT style
|
||
;; this requires an addition to or replacement of the default OrgOdtStyles.xml
|
||
(font-variant-small-caps
|
||
. ,(lambda (x) (concat "<text:span text:style-name=\"OrgSmallCaps\">" x "</text:span>")))
|
||
(font-weight-bold
|
||
. ,(lambda (x) (concat "<text:span text:style-name=\"Bold\">" x "</text:span>")))
|
||
(text-decoration-underline
|
||
. ,(lambda (x) (concat "<text:span text:style-name=\"Underline\">" x "</text:span>")))
|
||
(vertical-align-sub
|
||
. ,(lambda (x) (concat "<text:span text:style-name=\"OrgSubscript\">" x "</text:span>")))
|
||
(vertical-align-sup
|
||
. ,(lambda (x)
|
||
(concat "<text:span text:style-name=\"OrgSuperscript\">" x "</text:span>")))
|
||
;; TODO:
|
||
;; - display-left-margin
|
||
;; - display-right-inline
|
||
;; - display-block
|
||
;; - display-indent
|
||
))
|
||
|
||
(defun citeproc-fmt--org-odt-bib-formatter (items _bib-format)
|
||
"Return a html bibliography from already formatted ITEMS."
|
||
(mapconcat (lambda (i)
|
||
(concat "<text:p text:style-name=\"Text_20_body\">" i "</text:p>"))
|
||
items
|
||
"\n"))
|
||
|
||
;; Define the formatters alist
|
||
|
||
(defvar citeproc-fmt--formatters-alist
|
||
`((org-odt . ,(citeproc-formatter-create
|
||
:rt (citeproc-formatter-fun-create citeproc-fmt--org-odt-alist)
|
||
:bib #'citeproc-fmt--org-odt-bib-formatter
|
||
))
|
||
(html . ,(citeproc-formatter-create
|
||
:rt (citeproc-formatter-fun-create citeproc-fmt--html-alist)
|
||
:bib #'citeproc-fmt--html-bib-formatter))
|
||
(csl-test . ,(citeproc-formatter-create
|
||
:rt (citeproc-formatter-fun-create citeproc-fmt--csl-test-alist)
|
||
:bib #'citeproc-fmt--html-bib-formatter
|
||
:no-external-links t))
|
||
(raw . ,(citeproc-formatter-create :rt #'identity :bib (lambda (x _) x)))
|
||
(org . ,(citeproc-formatter-create :rt #'citeproc-fmt--org-format-rt))
|
||
(org-latex . ,(citeproc-formatter-create
|
||
:rt (citeproc-formatter-fun-create citeproc-fmt--org-latex-alist)
|
||
:bib #'citeproc-fmt--org-latex-bib-formatter))
|
||
(latex . ,(citeproc-formatter-create
|
||
:rt (citeproc-formatter-fun-create citeproc-fmt--latex-alist)
|
||
:bib (lambda (x _) (concat (mapconcat #'identity x "\n\n")
|
||
"\\bigskip"))))
|
||
(plain . ,(citeproc-formatter-create :rt #'citeproc-rt-to-plain
|
||
:no-external-links t)))
|
||
"Alist mapping supported output formats to formatter structs.")
|
||
|
||
(defun citeproc-formatter-for-format (format)
|
||
"Return the formatter struct belonging to FORMAT.
|
||
FORMAT is a symbol"
|
||
(if-let ((formatter (alist-get format citeproc-fmt--formatters-alist)))
|
||
formatter
|
||
(error "No formatter for citeproc format `%s'" format)))
|
||
|
||
(provide 'citeproc-formatters)
|
||
|
||
;;; citeproc-formatters.el ends here
|