oc-csl.el 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765
  1. ;;; oc-csl.el --- csl citation processor for Org -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
  3. ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
  4. ;; Maintainer: András Simonyi <andras.simonyi@gmail.com>
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; This library registers the `csl' citation processor, which provides
  18. ;; the "export" capability for citations.
  19. ;; The processor relies on the external Citeproc Emacs library, which must be
  20. ;; available prior to loading this library.
  21. ;; By default, citations are rendered in Chicago author-date CSL style. You can
  22. ;; use another style file by specifying it in `org-cite-export-processors' or
  23. ;; from within the document by adding the file name to "cite_export" keyword
  24. ;;
  25. ;; #+cite_export: csl /path/to/style-file.csl
  26. ;; #+cite_export: csl "/path/to/style-file.csl"
  27. ;;
  28. ;; With the variable `org-cite-csl-styles-dir' set appropriately, the
  29. ;; above can even be shortened to
  30. ;;
  31. ;; #+cite_export: csl style-file.csl
  32. ;;
  33. ;; Styles can be downloaded, for instance, from the Zotero Style Repository
  34. ;; (<https://www.zotero.org/styles>). Dependent styles (which are not "unique"
  35. ;; in the Zotero Style Repository terminology) are not supported.
  36. ;; The processor uses the "en-US" CSL locale file shipped with Org for rendering
  37. ;; localized dates and terms in the references, independently of the language
  38. ;; settings of the Org document. Additional CSL locales can be made available
  39. ;; by setting `org-cite-csl-locales-dir' to a directory containing the locale
  40. ;; files in question (see <https://github.com/citation-style-language/locales>
  41. ;; for such files).
  42. ;; Bibliography is defined with the "bibliography" keyword. It supports files
  43. ;; with ".bib", ".bibtex", and ".json" extensions. References are exported using
  44. ;; the "print_bibliography" keyword.
  45. ;; The library supports the following citation styles:
  46. ;;
  47. ;; - author (a), including bare (b), caps (c), bare-caps (bc), full (f),
  48. ;; caps-full (cf), and bare-caps-full (bcf) variants,
  49. ;; - noauthor (na), including bare (b), caps (c) and bare-caps (bc) variants,
  50. ;; - nocite (n),
  51. ;; - year (y), including a bare (b) variant,
  52. ;; - text (t), including caps (c), full (f), and caps-full (cf) variants,
  53. ;; - title (ti), including a bare (b) variant,
  54. ;; - locators (l), including a bare (b) variant,
  55. ;; - bibentry (b), including a bare (b) variant,
  56. ;; - default style, including bare (b), caps (c) and bare-caps (bc) variants.
  57. ;;
  58. ;; Using "*" as a key in a nocite citation includes all available
  59. ;; items in the printed bibliography. The "bibentry" citation style,
  60. ;; similarly to biblatex's \fullcite, creates a citation which is
  61. ;; similar to the bibliography entry.
  62. ;; CSL styles recognize "locator" in citation references' suffix. For example,
  63. ;; in the citation
  64. ;;
  65. ;; [cite:see @Tarski-1965 chapter 1, for an example]
  66. ;;
  67. ;; "chapter 1" is the locator. The whole citation is rendered as
  68. ;;
  69. ;; (see Tarski 1965, chap. 1 for an example)
  70. ;;
  71. ;; in the default CSL style.
  72. ;;
  73. ;; The locator starts with a locator term, among "bk.", "bks.", "book", "chap.",
  74. ;; "chaps.", "chapter", "col.", "cols.", "column", "figure", "fig.", "figs.",
  75. ;; "folio", "fol.", "fols.", "number", "no.", "nos.", "line", "l.", "ll.",
  76. ;; "note", "n.", "nn.", "opus", "op.", "opp.", "page", "p.", "pp.", "paragraph",
  77. ;; "para.", "paras.", "¶", "¶¶", "§", "§§", "part", "pt.", "pts.", "section",
  78. ;; "sec.", "secs.", "sub verbo", "s.v.", "s.vv.", "verse", "v.", "vv.",
  79. ;; "volume", "vol.", and "vols.". It ends with the last comma or digit in the
  80. ;; suffix, whichever comes last, or runs till the end of the suffix.
  81. ;;
  82. ;; The part of the suffix before the locator is appended to reference's prefix.
  83. ;; If no locator term is used, but a number is present, then "page" is assumed.
  84. ;; Filtered sub-bibliographies can be printed by passing filtering
  85. ;; options to the "print_bibliography" keywords. E.g.,
  86. ;;
  87. ;; #+print_bibliography: :type book keyword: emacs
  88. ;;
  89. ;; If you need to use a key multiple times, you can separate its
  90. ;; values with commas, but without any space in-between:
  91. ;;
  92. ;; #+print_bibliography: :keyword abc,xyz :type article
  93. ;; This library was heavily inspired by and borrows from András Simonyi's
  94. ;; Citeproc Org (<https://github.com/andras-simonyi/citeproc-org>) library.
  95. ;; Many thanks to him!
  96. ;;; Code:
  97. (require 'org-macs)
  98. (org-assert-version)
  99. (require 'cl-lib)
  100. (require 'map)
  101. (require 'bibtex)
  102. (require 'json)
  103. (require 'oc)
  104. (require 'citeproc nil t)
  105. (declare-function citeproc-style-cite-note "ext:citeproc")
  106. (declare-function citeproc-proc-style "ext:citeproc")
  107. (declare-function citeproc-bt-entry-to-csl "ext:citeproc")
  108. (declare-function citeproc-locale-getter-from-dir "ext:citeproc")
  109. (declare-function citeproc-create "ext:citeproc")
  110. (declare-function citeproc-citation-create "ext:citeproc")
  111. (declare-function citeproc-append-citations "ext:citeproc")
  112. (declare-function citeproc-add-uncited "ext:citeproc")
  113. (declare-function citeproc-render-citations "ext:citeproc")
  114. (declare-function citeproc-render-bib "ext:citeproc")
  115. (declare-function citeproc-hash-itemgetter-from-any "ext:citeproc")
  116. (declare-function citeproc-add-subbib-filters "ext:citeproc")
  117. (declare-function org-element-interpret-data "org-element" (data))
  118. (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
  119. (declare-function org-element-property "org-element" (property element))
  120. (declare-function org-element-put-property "org-element" (element property value))
  121. (declare-function org-export-data "org-export" (data info))
  122. (declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
  123. (declare-function org-export-get-footnote-number "org-export" (footnote info &optional data body-first))
  124. ;;; Customization
  125. ;;;; Location of CSL directories
  126. (defcustom org-cite-csl-locales-dir nil
  127. "Directory of CSL locale files.
  128. If nil then only the fallback en-US locale will be available."
  129. :group 'org-cite
  130. :package-version '(Org . "9.5")
  131. :type '(choice
  132. (directory :tag "Locales directory")
  133. (const :tag "Use en-US locale only" nil))
  134. ;; It's not obvious to me that arbitrary locations are safe.
  135. ;;; :safe #'string-or-null-p
  136. )
  137. (defcustom org-cite-csl-styles-dir nil
  138. "Directory of CSL style files.
  139. Relative style file names are expanded according to document's
  140. default directory. If it fails and the variable is non-nil, Org
  141. looks for style files in this directory, too."
  142. :group 'org-cite
  143. :package-version '(Org . "9.5")
  144. :type '(choice
  145. (directory :tag "Styles directory")
  146. (const :tag "No central directory for style files" nil))
  147. ;; It's not obvious to me that arbitrary locations are safe.
  148. ;;; :safe #'string-or-null-p
  149. )
  150. ;;;; Citelinks
  151. (defcustom org-cite-csl-link-cites t
  152. "When non-nil, link cites to references."
  153. :group 'org-cite
  154. :package-version '(Org . "9.5")
  155. :type 'boolean
  156. :safe #'booleanp)
  157. (defcustom org-cite-csl-no-citelinks-backends '(ascii)
  158. "List of export back-ends for which cite linking is disabled.
  159. Cite linking for export back-ends derived from any of the back-ends listed here,
  160. is also disabled."
  161. :group 'org-cite
  162. :package-version '(Org . "9.5")
  163. :type '(repeat symbol))
  164. ;;;; Output-specific variables
  165. (defcustom org-cite-csl-html-hanging-indent "1.5em"
  166. "Size of hanging-indent for HTML output in valid CSS units."
  167. :group 'org-cite
  168. :package-version '(Org . "9.5")
  169. :type 'string
  170. :safe #'stringp)
  171. (defcustom org-cite-csl-html-label-width-per-char "0.6em"
  172. "Character width in CSS units for calculating entry label widths.
  173. Used only when `second-field-align' is activated by the used CSL style."
  174. :group 'org-cite
  175. :package-version '(Org . "9.5")
  176. :type 'string
  177. :safe #'stringp)
  178. (defcustom org-cite-csl-latex-hanging-indent "1.5em"
  179. "Size of hanging-indent for LaTeX output in valid LaTeX units."
  180. :group 'org-cite
  181. :package-version '(Org . "9.5")
  182. :type 'string
  183. :safe #'stringp)
  184. ;;; Internal variables
  185. (defconst org-cite-csl--etc-dir
  186. (let ((oc-root (file-name-directory (locate-library "oc"))))
  187. (cond
  188. ;; First check whether it looks like we're running from the main
  189. ;; Org repository.
  190. ((let ((csl-org (expand-file-name "../etc/csl/" oc-root)))
  191. (and (file-directory-p csl-org) csl-org)))
  192. ;; Next look for the directory alongside oc.el because package.el
  193. ;; and straight will put all of org-mode/lisp/ in org-mode/.
  194. ((let ((csl-pkg (expand-file-name "etc/csl/" oc-root)))
  195. (and (file-directory-p csl-pkg) csl-pkg)))
  196. ;; Finally fall back the location used by shared system installs
  197. ;; and when running directly from Emacs repository.
  198. (t
  199. (expand-file-name "org/csl/" data-directory))))
  200. "Directory containing CSL-related data files.")
  201. (defconst org-cite-csl--fallback-locales-dir org-cite-csl--etc-dir
  202. "Fallback CSL locale files directory.")
  203. (defconst org-cite-csl--fallback-style-file
  204. (expand-file-name "chicago-author-date.csl"
  205. org-cite-csl--etc-dir)
  206. "Default CSL style file, or nil.
  207. If nil then the Chicago author-date style is used as a fallback.")
  208. (defconst org-cite-csl--label-alist
  209. '(("bk." . "book")
  210. ("bks." . "book")
  211. ("book" . "book")
  212. ("chap." . "chapter")
  213. ("chaps." . "chapter")
  214. ("chapter" . "chapter")
  215. ("col." . "column")
  216. ("cols." . "column")
  217. ("column" . "column")
  218. ("figure" . "figure")
  219. ("fig." . "figure")
  220. ("figs." . "figure")
  221. ("folio" . "folio")
  222. ("fol." . "folio")
  223. ("fols." . "folio")
  224. ("number" . "number")
  225. ("no." . "number")
  226. ("nos." . "number")
  227. ("line" . "line")
  228. ("l." . "line")
  229. ("ll." . "line")
  230. ("note" . "note")
  231. ("n." . "note")
  232. ("nn." . "note")
  233. ("opus" . "opus")
  234. ("op." . "opus")
  235. ("opp." . "opus")
  236. ("page" . "page")
  237. ("p" . "page")
  238. ("p." . "page")
  239. ("pp." . "page")
  240. ("paragraph" . "paragraph")
  241. ("para." . "paragraph")
  242. ("paras." . "paragraph")
  243. ("¶" . "paragraph")
  244. ("¶¶" . "paragraph")
  245. ("part" . "part")
  246. ("pt." . "part")
  247. ("pts." . "part")
  248. ("§" . "section")
  249. ("§§" . "section")
  250. ("section" . "section")
  251. ("sec." . "section")
  252. ("secs." . "section")
  253. ("sub verbo" . "sub verbo")
  254. ("s.v." . "sub verbo")
  255. ("s.vv." . "sub verbo")
  256. ("verse" . "verse")
  257. ("v." . "verse")
  258. ("vv." . "verse")
  259. ("volume" . "volume")
  260. ("vol." . "volume")
  261. ("vols." . "volume"))
  262. "Alist mapping locator names to locators.")
  263. (defconst org-cite-csl--label-regexp
  264. ;; Prior to Emacs-27.1 argument of `regexp' form must be a string literal.
  265. ;; It is the reason why `rx' is avoided here.
  266. (rx-to-string
  267. `(seq (or line-start space)
  268. (regexp ,(regexp-opt (mapcar #'car org-cite-csl--label-alist) t))
  269. (0+ digit)
  270. (or word-end line-end space " "))
  271. t)
  272. "Regexp matching a label in a citation reference suffix.
  273. Label is in match group 1.")
  274. ;;; Internal functions
  275. (defun org-cite-csl--barf-without-citeproc ()
  276. "Raise an error if Citeproc library is not loaded."
  277. (unless (featurep 'citeproc)
  278. (error "Citeproc library is not loaded")))
  279. (defun org-cite-csl--note-style-p (info)
  280. "Non-nil when bibliography style implies wrapping citations in footnotes.
  281. INFO is the export state, as a property list."
  282. (citeproc-style-cite-note
  283. (citeproc-proc-style
  284. (org-cite-csl--processor info))))
  285. (defun org-cite-csl--nocite-p (citation info)
  286. "Non-nil when CITATION object's style is nocite.
  287. INFO is the export state, as a property list."
  288. (member (car (org-cite-citation-style citation info))
  289. '("nocite" "n")))
  290. (defun org-cite-csl--create-structure-params (citation info)
  291. "Return citeproc structure creation params for CITATION object.
  292. STYLE is the citation style, as a string or nil. INFO is the export state, as
  293. a property list."
  294. (let ((style (org-cite-citation-style citation info)))
  295. (pcase style
  296. ;; "author" style.
  297. (`(,(or "author" "a") . ,variant)
  298. (pcase variant
  299. ((or "bare" "b") '(:mode author-only :suppress-affixes t))
  300. ((or "caps" "c") '(:mode author-only :capitalize-first t))
  301. ((or "full" "f") '(:mode author-only :ignore-et-al t))
  302. ((or "bare-caps" "bc") '(:mode author-only :suppress-affixes t :capitalize-first t))
  303. ((or "bare-full" "bf") '(:mode author-only :suppress-affixes t :ignore-et-al t))
  304. ((or "caps-full" "cf") '(:mode author-only :capitalize-first t :ignore-et-al t))
  305. ((or "bare-caps-full" "bcf") '(:mode author-only :suppress-affixes t :capitalize-first t :ignore-et-al t))
  306. (_ '(:mode author-only))))
  307. ;; "noauthor" style.
  308. (`(,(or "noauthor" "na") . ,variant)
  309. (pcase variant
  310. ((or "bare" "b") '(:mode suppress-author :suppress-affixes t))
  311. ((or "caps" "c") '(:mode suppress-author :capitalize-first t))
  312. ((or "bare-caps" "bc")
  313. '(:mode suppress-author :suppress-affixes t :capitalize-first t))
  314. (_ '(:mode suppress-author))))
  315. ;; "year" style.
  316. (`(,(or "year" "y") . ,variant)
  317. (pcase variant
  318. ((or "bare" "b") '(:mode year-only :suppress-affixes t))
  319. (_ '(:mode year-only))))
  320. ;; "bibentry" style.
  321. (`(,(or "bibentry" "b") . ,variant)
  322. (pcase variant
  323. ((or "bare" "b") '(:mode bib-entry :suppress-affixes t))
  324. (_ '(:mode bib-entry))))
  325. ;; "locators" style.
  326. (`(,(or "locators" "l") . ,variant)
  327. (pcase variant
  328. ((or "bare" "b") '(:mode locator-only :suppress-affixes t))
  329. (_ '(:mode locator-only))))
  330. ;; "title" style.
  331. (`(,(or "title" "ti") . ,variant)
  332. (pcase variant
  333. ((or "bare" "b") '(:mode title-only :suppress-affixes t))
  334. (_ '(:mode title-only))))
  335. ;; "text" style.
  336. (`(,(or "text" "t") . ,variant)
  337. (pcase variant
  338. ((or "caps" "c") '(:mode textual :capitalize-first t))
  339. ((or "full" "f") '(:mode textual :ignore-et-al t))
  340. ((or "caps-full" "cf") '(:mode textual :ignore-et-al t :capitalize-first t))
  341. (_ '(:mode textual))))
  342. ;; Default "nil" style.
  343. (`(,_ . ,variant)
  344. (pcase variant
  345. ((or "caps" "c") '(:capitalize-first t))
  346. ((or "bare" "b") '(:suppress-affixes t))
  347. ((or "bare-caps" "bc") '(:suppress-affixes t :capitalize-first t))
  348. (_ nil)))
  349. ;; This should not happen.
  350. (_ (error "Invalid style: %S" style)))))
  351. (defun org-cite-csl--no-citelinks-p (info)
  352. "Non-nil when export BACKEND should not create cite-reference links."
  353. (or (not org-cite-csl-link-cites)
  354. (and org-cite-csl-no-citelinks-backends
  355. (apply #'org-export-derived-backend-p
  356. (plist-get info :back-end)
  357. org-cite-csl-no-citelinks-backends))
  358. ;; No references are being exported anyway.
  359. (not (org-element-map (plist-get info :parse-tree) 'keyword
  360. (lambda (k)
  361. (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key k)))
  362. info t))))
  363. (defun org-cite-csl--output-format (info)
  364. "Return expected Citeproc's output format.
  365. INFO is the export state, as a property list. The return value is a symbol
  366. corresponding to one of the output formats supported by Citeproc: `html',
  367. `latex', or `org'."
  368. (let ((backend (plist-get info :back-end)))
  369. (cond
  370. ((org-export-derived-backend-p backend 'html) 'html)
  371. ((org-export-derived-backend-p backend 'latex) 'latex)
  372. (t 'org))))
  373. (defun org-cite-csl--style-file (info)
  374. "Return style file associated to current export process.
  375. INFO is the export state, as a property list.
  376. When file name is relative, look for it in buffer's default
  377. directory, failing that in `org-cite-csl-styles-dir' if non-nil.
  378. Raise an error if no style file can be found."
  379. (pcase (org-cite-bibliography-style info)
  380. ('nil org-cite-csl--fallback-style-file)
  381. ((and (pred file-name-absolute-p) file) file)
  382. ((and (pred file-exists-p) file) (expand-file-name file))
  383. ((and (guard org-cite-csl-styles-dir)
  384. (pred (lambda (f)
  385. (file-exists-p
  386. (expand-file-name f org-cite-csl-styles-dir))))
  387. file)
  388. (expand-file-name file org-cite-csl-styles-dir))
  389. (other
  390. (user-error "CSL style file not found: %S" other))))
  391. (defun org-cite-csl--locale-getter ()
  392. "Return a locale getter.
  393. The getter looks for locales in `org-cite-csl-locales-dir' directory. If it
  394. cannot find them, it retrieves the default \"en_US\" from
  395. `org-cite-csl--fallback-locales-dir'."
  396. (lambda (loc)
  397. (or (and org-cite-csl-locales-dir
  398. (ignore-errors
  399. (funcall (citeproc-locale-getter-from-dir org-cite-csl-locales-dir)
  400. loc)))
  401. (funcall (citeproc-locale-getter-from-dir
  402. org-cite-csl--fallback-locales-dir)
  403. loc))))
  404. (defun org-cite-csl--processor (info)
  405. "Return Citeproc processor reading items from current bibliography.
  406. INFO is the export state, as a property list.
  407. Newly created processor is stored as the value of the `:cite-citeproc-processor'
  408. property in INFO."
  409. (or (plist-get info :cite-citeproc-processor)
  410. (let* ((bibliography (plist-get info :bibliography))
  411. (locale (or (plist-get info :language) "en_US"))
  412. (processor
  413. (citeproc-create
  414. (org-cite-csl--style-file info)
  415. (citeproc-hash-itemgetter-from-any bibliography)
  416. (org-cite-csl--locale-getter)
  417. locale)))
  418. (plist-put info :cite-citeproc-processor processor)
  419. processor)))
  420. (defun org-cite-csl--parse-reference (reference info)
  421. "Return Citeproc's structure associated to citation REFERENCE.
  422. INFO is the export state, as a property list.
  423. The result is a association list. Keys are: `id', `prefix',`suffix',
  424. `location', `locator' and `label'."
  425. (let (label location-start locator-start location locator prefix suffix)
  426. ;; Parse suffix. Insert it in a temporary buffer to find
  427. ;; different parts: pre-label, label, locator, location (label +
  428. ;; locator), and suffix.
  429. (with-temp-buffer
  430. (save-excursion
  431. (insert (org-element-interpret-data
  432. (org-element-property :suffix reference))))
  433. (cond
  434. ((re-search-forward org-cite-csl--label-regexp nil t)
  435. (setq location-start (match-beginning 0))
  436. (setq label (cdr (assoc (match-string 1) org-cite-csl--label-alist)))
  437. (goto-char (match-end 1))
  438. (skip-chars-forward "[:space:] ")
  439. (setq locator-start (point)))
  440. ((re-search-forward (rx digit) nil t)
  441. (setq location-start (match-beginning 0))
  442. (setq label "page")
  443. (setq locator-start location-start))
  444. (t
  445. (setq suffix (org-element-property :suffix reference))))
  446. ;; Find locator's end, and suffix, if any. To that effect, look
  447. ;; for the last comma or digit after label, whichever comes
  448. ;; last.
  449. (unless suffix
  450. (goto-char (point-max))
  451. (let ((re (rx (or "," (group digit)))))
  452. (when (re-search-backward re location-start t)
  453. (goto-char (or (match-end 1) (match-beginning 0)))
  454. (setq location (buffer-substring location-start (point)))
  455. (setq locator (org-trim (buffer-substring locator-start (point))))
  456. ;; Skip comma in suffix.
  457. (setq suffix
  458. (org-cite-parse-objects
  459. (buffer-substring (match-end 0) (point-max))
  460. t)))))
  461. (setq prefix
  462. (org-cite-concat
  463. (org-element-property :prefix reference)
  464. (and location-start
  465. (org-cite-parse-objects
  466. (buffer-substring 1 location-start)
  467. t)))))
  468. ;; Return value.
  469. (let ((export
  470. (lambda (data)
  471. (org-string-nw-p
  472. (org-trim
  473. ;; When Citeproc exports to Org syntax, avoid mix and
  474. ;; matching output formats by also generating Org
  475. ;; syntax for prefix and suffix.
  476. (if (eq 'org (org-cite-csl--output-format info))
  477. (org-element-interpret-data data)
  478. (org-export-data data info)))))))
  479. `((id . ,(org-element-property :key reference))
  480. (prefix . ,(funcall export prefix))
  481. (suffix . ,(funcall export suffix))
  482. (locator . ,locator)
  483. (label . ,label)
  484. (location . ,location)))))
  485. (defun org-cite-csl--create-structure (citation info)
  486. "Create Citeproc structure for CITATION object.
  487. INFO is the export state, as a property list."
  488. (let* ((cites (mapcar (lambda (r)
  489. (org-cite-csl--parse-reference r info))
  490. (org-cite-get-references citation)))
  491. (footnote (org-cite-inside-footnote-p citation)))
  492. ;; Global prefix is inserted in front of the prefix of the first
  493. ;; reference.
  494. (let ((global-prefix (org-element-property :prefix citation)))
  495. (when global-prefix
  496. (let* ((first (car cites))
  497. (prefix-item (assq 'prefix first)))
  498. (setcdr prefix-item
  499. (concat (org-element-interpret-data global-prefix)
  500. " "
  501. (cdr prefix-item))))))
  502. ;; Global suffix is appended to the suffix of the last reference.
  503. (let ((global-suffix (org-element-property :suffix citation)))
  504. (when global-suffix
  505. (let* ((last (org-last cites))
  506. (suffix-item (assq 'suffix last)))
  507. (setcdr suffix-item
  508. (concat (cdr suffix-item)
  509. " "
  510. (org-element-interpret-data global-suffix))))))
  511. ;; Check if CITATION needs wrapping, i.e., it should be wrapped in
  512. ;; a footnote, but isn't yet.
  513. (when (and (not footnote) (org-cite-csl--note-style-p info))
  514. (org-cite-adjust-note citation info)
  515. (setq footnote (org-cite-wrap-citation citation info)))
  516. ;; Return structure.
  517. (apply #'citeproc-citation-create
  518. `(:note-index
  519. ,(and footnote (org-export-get-footnote-number footnote info))
  520. :cites ,cites
  521. ,@(org-cite-csl--create-structure-params citation info)))))
  522. (defun org-cite-csl--rendered-citations (info)
  523. "Return the rendered citations as an association list.
  524. INFO is the export state, as a property list.
  525. Return an alist (CITATION . OUTPUT) where CITATION object has been rendered as
  526. OUTPUT using Citeproc."
  527. (or (plist-get info :cite-citeproc-rendered-citations)
  528. (let ((citations (org-cite-list-citations info))
  529. (processor (org-cite-csl--processor info))
  530. normal-citations nocite-ids)
  531. (dolist (citation citations)
  532. (if (org-cite-csl--nocite-p citation info)
  533. (setq nocite-ids (append (org-cite-get-references citation t) nocite-ids))
  534. (push citation normal-citations)))
  535. (let ((structures
  536. (mapcar (lambda (c) (org-cite-csl--create-structure c info))
  537. (nreverse normal-citations))))
  538. (citeproc-append-citations structures processor))
  539. (when nocite-ids
  540. (citeproc-add-uncited nocite-ids processor))
  541. ;; All bibliographies have to be rendered in order to have
  542. ;; correct citation numbers even if there are several
  543. ;; sub-bibliograhies.
  544. (org-cite-csl--rendered-bibliographies info)
  545. (let (result
  546. (rendered (citeproc-render-citations
  547. processor
  548. (org-cite-csl--output-format info)
  549. (org-cite-csl--no-citelinks-p info))))
  550. (dolist (citation citations)
  551. (push (cons citation
  552. (if (org-cite-csl--nocite-p citation info) "" (pop rendered)))
  553. result))
  554. (setq result (nreverse result))
  555. (plist-put info :cite-citeproc-rendered-citations result)
  556. result))))
  557. (defun org-cite-csl--bibliography-filter (bib-props)
  558. "Return the sub-bibliography filter corresponding to bibliography properties.
  559. BIB-PROPS should be a plist representing the properties
  560. associated with a \"print_bibliography\" keyword, as returned by
  561. `org-cite-bibliography-properties'."
  562. (let (result
  563. (remove-keyword-colon (lambda (x) (intern (substring (symbol-name x) 1)))))
  564. (map-do
  565. (lambda (key value)
  566. (pcase key
  567. ((or :keyword :notkeyword :nottype :notcsltype :filter)
  568. (dolist (v (split-string value ","))
  569. (push (cons (funcall remove-keyword-colon key) v) result)))
  570. ((or :type :csltype)
  571. (if (string-match-p "," value)
  572. (user-error "The \"%s\" print_bibliography option does not support comma-separated values" key)
  573. (push (cons (funcall remove-keyword-colon key) value) result)))))
  574. bib-props)
  575. result))
  576. (defun org-cite-csl--rendered-bibliographies (info)
  577. "Return the rendered bibliographies.
  578. INFO is the export state, as a property list.
  579. Return an (OUTPUTS PARAMETERS) list where OUTPUTS is an alist
  580. of (BIB-PROPS . OUTPUT) pairs where each key is a property list
  581. of a \"print_bibliography\" keyword and the corresponding OUTPUT
  582. value is the bibliography as rendered by Citeproc."
  583. (or (plist-get info :cite-citeproc-rendered-bibliographies)
  584. (let (bib-plists bib-filters)
  585. ;; Collect bibliography property lists and the corresponding
  586. ;; Citeproc sub-bib filters.
  587. (org-element-map (plist-get info :parse-tree) 'keyword
  588. (lambda (keyword)
  589. (when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword))
  590. (let ((bib-plist (org-cite-bibliography-properties keyword)))
  591. (push bib-plist bib-plists)
  592. (push (org-cite-csl--bibliography-filter bib-plist) bib-filters)))))
  593. (setq bib-filters (nreverse bib-filters)
  594. bib-plists (nreverse bib-plists))
  595. ;; Render and return all bibliographies.
  596. (let ((processor (org-cite-csl--processor info)))
  597. (citeproc-add-subbib-filters bib-filters processor)
  598. (pcase-let* ((format (org-cite-csl--output-format info))
  599. (`(,rendered-bibs . ,parameters)
  600. (citeproc-render-bib
  601. (org-cite-csl--processor info)
  602. format
  603. (org-cite-csl--no-citelinks-p info)))
  604. (outputs (cl-mapcar #'cons bib-plists rendered-bibs))
  605. (result (list outputs parameters)))
  606. (plist-put info :cite-citeproc-rendered-bibliographies result)
  607. result)))))
  608. ;;; Export capability
  609. (defun org-cite-csl-render-citation (citation _style _backend info)
  610. "Export CITATION object.
  611. INFO is the export state, as a property list."
  612. (org-cite-csl--barf-without-citeproc)
  613. (let ((output (cdr (assq citation (org-cite-csl--rendered-citations info)))))
  614. (if (not (eq 'org (org-cite-csl--output-format info)))
  615. output
  616. ;; Parse Org output to re-export it during the regular export
  617. ;; process.
  618. (org-cite-parse-objects output))))
  619. (defun org-cite-csl-render-bibliography (_keys _files _style props _backend info)
  620. "Export bibliography.
  621. INFO is the export state, as a property list."
  622. (org-cite-csl--barf-without-citeproc)
  623. (pcase-let* ((format (org-cite-csl--output-format info))
  624. (`(,outputs ,parameters) (org-cite-csl--rendered-bibliographies info))
  625. (output (cdr (assoc props outputs))))
  626. (pcase format
  627. ('html
  628. (concat
  629. (and (cdr (assq 'second-field-align parameters))
  630. (let* ((max-offset (cdr (assq 'max-offset parameters)))
  631. (char-width
  632. (string-to-number org-cite-csl-html-label-width-per-char))
  633. (char-width-unit
  634. (progn
  635. (string-match (number-to-string char-width)
  636. org-cite-csl-html-label-width-per-char)
  637. (substring org-cite-csl-html-label-width-per-char
  638. (match-end 0)))))
  639. (format
  640. "<style>.csl-left-margin{float: left; padding-right: 0em;}
  641. .csl-right-inline{margin: 0 0 0 %d%s;}</style>"
  642. (* max-offset char-width)
  643. char-width-unit)))
  644. (and (cdr (assq 'hanging-indent parameters))
  645. (format
  646. "<style>.csl-entry{text-indent: -%s; margin-left: %s;}</style>"
  647. org-cite-csl-html-hanging-indent
  648. org-cite-csl-html-hanging-indent))
  649. output))
  650. ('latex
  651. (if (cdr (assq 'hanging-indent parameters))
  652. (format "\\begin{hangparas}{%s}{1}\n%s\n\\end{hangparas}"
  653. org-cite-csl-latex-hanging-indent
  654. output)
  655. output))
  656. (_
  657. ;; Parse Org output to re-export it during the regular export
  658. ;; process.
  659. (org-cite-parse-elements output)))))
  660. (defun org-cite-csl-finalizer (output _keys _files _style _backend info)
  661. "Add \"hanging\" package if missing from LaTeX output.
  662. OUTPUT is the export document, as a string. INFO is the export state, as a
  663. property list."
  664. (org-cite-csl--barf-without-citeproc)
  665. (if (not (eq 'latex (org-cite-csl--output-format info)))
  666. output
  667. (with-temp-buffer
  668. (save-excursion (insert output))
  669. (when (search-forward "\\begin{document}" nil t)
  670. (goto-char (match-beginning 0))
  671. ;; Ensure that \citeprocitem is defined for citeproc-el.
  672. (insert "\\makeatletter\n\\newcommand{\\citeprocitem}[2]{\\hyper@linkstart{cite}{citeproc_bib_item_#1}#2\\hyper@linkend}\n\\makeatother\n\n")
  673. ;; Ensure there is a \usepackage{hanging} somewhere or add one.
  674. (let ((re (rx "\\usepackage" (opt "[" (*? nonl) "]") "{hanging}")))
  675. (unless (re-search-backward re nil t)
  676. (insert "\\usepackage[notquote]{hanging}\n"))))
  677. (buffer-string))))
  678. ;;; Register `csl' processor
  679. (org-cite-register-processor 'csl
  680. :export-citation #'org-cite-csl-render-citation
  681. :export-bibliography #'org-cite-csl-render-bibliography
  682. :export-finalizer #'org-cite-csl-finalizer
  683. :cite-styles
  684. '((("author" "a") ("bare" "b") ("caps" "c") ("full" "f") ("bare-caps" "bc") ("caps-full" "cf") ("bare-caps-full" "bcf"))
  685. (("noauthor" "na") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
  686. (("year" "y") ("bare" "b"))
  687. (("text" "t") ("caps" "c") ("full" "f") ("caps-full" "cf"))
  688. (("nil") ("bare" "b") ("caps" "c") ("bare-caps" "bc"))
  689. (("nocite" "n"))
  690. (("title" "ti") ("bare" "b"))
  691. (("bibentry" "b") ("bare" "b"))
  692. (("locators" "l") ("bare" "b"))))
  693. (provide 'oc-csl)
  694. ;;; oc-csl.el ends here