diff --git a/lisp/oc.el b/lisp/oc.el new file mode 100644 index 000000000..1d704fb03 --- /dev/null +++ b/lisp/oc.el @@ -0,0 +1,1552 @@ +;;; oc.el --- Org Cite library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou + +;; 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 . + +;;; Commentary: + +;; This library provides tooling to handle citations in Org, e.g, activate, +;; follow, insert, and export them, respectively called "activate", "follow", +;; "insert" and "export" capabilities. Libraries responsible for providing +;; some, or all, of these capabilities are called "citation processors". + +;; Such processors are defined using `org-cite-register-processor'. Using this +;; function, it is possible, in addition to giving it a name, to attach +;; functions associated to capabilities. As such, a processor handling citation +;; export must set the `:export-citation' property to an appropriate function. +;; Likewise, "activate" capability requires an appropriate `:activate' property, +;; "insert" requires `:insert' property and, unsurprisingly, "follow" capability +;; implies `:follow' property. + +;; As a user, the first thing to do is setting a bibliography, either globally +;; with `org-cite-global-bibliography', or locally using one; ore more +;; "bibliography" keywords. Then one can select any registered processor for +;; each capability by providing a processor name to the variables +;; `org-cite-activate-processor' and `org-cite-follow-processor'. + +;; The "export" capability is slightly more involved as one need to select the +;; processor providing it, but may also provide a default style for citations +;; and bibliography. Also, the choice of an export processor may depend of the +;; current export back-end. The association between export back-ends and +;; triplets of parameters can be set in `org-cite-export-processors' variable, +;; or in a document, through the "cite_export" keyword. + +;; Eventually, this library provides some tools, mainly targeted at processor +;; implementors. Most are export-specific and are located in the "Tools only +;; available during export" and "Tools generating or operating on parsed data" +;; sections. + +;; The few others can be used directly from an Org buffer, or operate on +;; processors. See "Generic tools" section. + +;;; Code: + +(require 'org-compat) +(require 'org-macs) + +(declare-function org-collect-keywords "org" (keywords &optional unique directory)) + +(declare-function org-element-adopt-elements "org-element" (parent &rest children)) +(declare-function org-element-citation-parser "org-element" ()) +(declare-function org-element-citation-reference-parser "org-element" ()) +(declare-function org-element-class "org-element" (datum &optional parent)) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-create "org-element" (type &optional props &rest children)) +(declare-function org-element-extract-element "org-element" (element)) +(declare-function org-element-insert-before "org-element" (element location)) +(declare-function org-element-lineage "org-element" (datum &optional types with-self)) +(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) +(declare-function org-element-normalize-string "org-element" (s)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) +(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" (element property value)) +(declare-function org-element-restriction "org-element" (element)) +(declare-function org-element-set-element "org-element" (old new)) +(declare-function org-element-type "org-element" (element)) + +(declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) +(declare-function org-export-get-footnote-definition "org-export" (footnote-reference info)) +(declare-function org-export-get-next-element "org-export" (blob info &optional n)) +(declare-function org-export-get-previous-element "org-export" (blob info &optional n)) +(declare-function org-export-raw-string "org-export" (s)) + +(defvar org-element-all-objects) +(defvar org-element-citation-key-re) +(defvar org-element-citation-prefix-re) + + +;;; Constants +;; Borrowed from "citeproc.el" library. +(defconst org-cite--default-region-alist + '(("af" . "za") ("ca" . "ad") ("cs" . "cz") ("cy" . "gb") + ("da" . "dk") ("el" . "gr") ("et" . "ee") ("fa" . "ir") + ("he" . "ir") ("ja" . "jp") ("km" . "kh") ("ko" . "kr") + ("nb" . "no") ("nn" . "no") ("sl" . "si") ("sr" . "rs") + ("sv" . "se") ("uk" . "ua") ("vi" . "vn") ("zh" . "cn")) + "Alist mapping those languages to their default region. +Only those languages are given for which the default region is not simply the +result of duplicating the language part.") + + +;;; Configuration variables +(defgroup org-cite nil + "Options concerning citations in Org mode." + :group 'org + :tag "Org Cite") + +(defcustom org-cite-global-bibliography nil + "List of bibliography files available in all documents. +File names must be absolute." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(choice (const :tag "No global bibliography" nil) + (repeat :tag "List of bibliography files" + (file :tag "Bibliography"))) + :safe t) + +(defcustom org-cite-activate-processor 'basic + "Processor used for activating citations, as a symbol." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(choice (const :tag "Default fontification" nil) + (symbol :tag "Citation processor")) + :safe nil) + +(defcustom org-cite-export-processors '((t basic)) + "Processor used for exporting citations, as a triplet, or nil. + +When nil, citations and bibliography are not exported. + +When non-nil, the value is an association list between export back-ends and +citation export processors: + + (BACK-END . PROCESSOR) + +where BACK-END is the name of an export back-end or t, and PROCESSOR is a +triplet following the pattern + + (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) + +There, NAME is the name of a registered citation processor providing export +functionality, as a symbol. BIBLIOGRAPHY-STYLE (resp. CITATION-STYLE) is the +desired default style to use when printing a bibliography (resp. exporting a +citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and CITATION-STYLE are +optional. NAME is mandatory. + +The export process selects the citation processor associated to the current +export back-end, or the most specific back-end the current one is derived from, +or, if all are inadequate, to the processor associated to t. For example, with +the following value + + ((beamer natbib) + (latex biblatex) + (t csl)) + +exporting with `beamer' or any back-end derived from it will use `natbib', +whereas exporting with `latex' or any back-end derived from it but different +from `beamer' will use `biblatex' processor. Any other back-end, such as +`html', will use `csl' processor. + +CITATION-STYLE is overridden by adding a style to any citation object. A nil +style lets the export processor choose the default output. Any style not +recognized by the export processor is equivalent to nil. + +The citation triplet can also be set with the CITE_EXPORT keyword. +E.g., + + #+CITE_EXPORT: basic note numeric + +or + + #+CITE_EXPORT: basic + +In that case, `basic' processor is used on every export, independently on the +back-end." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(choice (const :tag "No export" nil) + (alist :key-type symbol + :value-type + (list :tag "Citation processor" + (symbol :tag "Processor name") + (choice + (const :tag "Default bibliography style" nil) + (string :tag "Use specific bibliography style")) + (choice + (const :tag "Default citation style" nil) + (string :tag "Use specific citation style"))))) + :safe nil) + +(defcustom org-cite-follow-processor 'basic + "Processor used for following citations, as a symbol." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(choice (const :tag "No following" nil) + (symbol :tag "Citation processor")) + :safe nil) + +(defcustom org-cite-insert-processor 'basic + "Processor used for inserting citations, as a symbol." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(choice (const :tag "No insertion" nil) + (symbol :tag "Citation processor")) + :safe nil) + +(defcustom org-cite-adjust-note-numbers t + "When non-nil, allow process to modify location of note numbers. + +When this variable is non-nil, it is possible to swap between author-date and +note style without modifying the document. To that effect, citations should +always be located as in an author-date style. Prior to turning the citation +into a footnote, the citation processor moves the citation (i.e., the future +note number), and the surrounding punctuation, according to rules defined in +`org-cite-note-rules'. + +When nil, the note number is not moved." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(choice (const :tag "Automatic note number location" t) + (const :tag "Place note numbers manually" nil)) + :safe t) + +(defcustom org-cite-note-rules + '(("en-us" inside outside after) + ("fr" adaptive same before)) + "Alist between languages and typographic rules for citations in note style. + +When `org-cite-adjust-note-numbers' is non-nil, and note style is requested, +citation processor is allowed to move the note marker according to some specific +rules, detailed here. More accurately, a rule is a list following the pattern + + (LANGUAGE-TAG . RULE) + + LANGUAGE-TAG is a down-cased string representing a language tag as defined in + RFC 4646. It may constituted of a language and a region separated with an + hyphen (e.g., \"en-us\"), or the language alone (e.g., \"fr\"). A language + without a region applies to all regions. + + RULE is a triplet + + (PUNCTUATION NUMBER ORDER) + + PUNCTUATION is the desired location of the punctuation with regards to the + quotation, if any. It may be `inside', `outside', or `adaptive'. The latter + permits subtler control over the punctuation: when there is no space between + the quotation mark and the punctuation, it is equivalent to `inside'. + Otherwise, it means `outside', as illustrated in the following examples: + + \"A quotation ending without punctuation\" [cite:@org21]. + \"A quotation ending with a period\"[cite:@org21]. + + Notwithstanding the above, a space always appear before the citation when it + is to become anything else than a note. + + NUMBER is the desired location of the note number with regards to the + quotation mark, if any. It may be `inside', `outside', or `same'. When set + to `same', the number appears on the same side as the punctuation, unless + there is punctuation on both sides or on none. + + ORDER is the relative position of the citation with regards to the closest + punctuation. It may be `after' or `before'. + +For example (adaptive same before) corresponds to French typography. + +When the locale is unknown to this variable, the default rule is: + + (adaptive outside after) + +This roughly follows the Oxford Guide to Style recommendations." + :group 'org-cite + :package-version '(Org . "9.5") + :type + '(repeat + (list :tag "Typographic rule" + (string :tag "Language code") + (choice :tag "Location of punctuation" + (const :tag "Punctuation inside quotation" inside) + (const :tag "Punctuation outside quotation" outside) + (const :tag "Location depends on spacing" adaptive)) + (choice :tag "Location of citation" + (const :tag "Citation inside quotation" inside) + (const :tag "Citation outside quotation" outside) + (const :tag "Citation next to punctuation" same)) + (choice :tag "Order of citation and punctuation" + (const :tag "Citation first" before) + (const :tag "Citation last" after)))) + :safe t) + +(defcustom org-cite-punctuation-marks '("." "," ";" ":" "!" "?") + "List of strings that can be moved around when placing note numbers. + +When `org-cite-adjust-note-numbers' is non-nil, the citation processor is +allowed to shuffle punctuation marks specified in this list in order to +place note numbers according to rules defined in `org-cite-note-rules'." + :group 'org-cite + :package-version '(Org . "9.5") + :type '(repeat string) + :safe t) + + +;;; Citation processors +(cl-defstruct (org-cite-processor (:constructor org-cite--make-processor) + (:copier nil)) + (name nil :read-only t) + (activate nil :read-only t) + (cite-styles nil :read-only t) + (export-bibliography nil :read-only t) + (export-citation nil :read-only t) + (export-finalizer nil :read-only t) + (follow nil :read-only t) + (insert nil :read-only t)) + +(defvar org-cite--processors nil + "List of registered citation processors. +See `org-cite-register-processor' for more information about +processors.") + +(defun org-cite--get-processor (name) + "Return citation processor named after symbol NAME. +Return nil if no such processor is found." + (seq-find (lambda (p) (eq name (org-cite-processor-name p))) + org-cite--processors)) + +(defun org-cite-register-processor (name &rest body) + "Mark citation processor NAME as available. + +NAME is a symbol. BODY is a property list, where the following optional keys +can be set: + + `:activate' + + Function activating a citation. It is called with a single argument: a + citation object extracted from the current buffer. It may add text + properties to the buffer. If it is not provided, `org-cite-fontify-default' + is used. + + `:export-bibliography' + + Function rendering a bibliography. It is called with six arguments: the + list of citation keys used in the document, as strings, a list of + bibliography files, the style, as a string or nil, the local properties, as + a property list, the export back-end, as a symbol, and the communication + channel, as a property list. + + It is called at each \"print_bibliography\" keyword in the parse tree. + It may return a string, a parsed element, a list of parsed elements, or nil. + When it returns nil, the keyword is ignored. Otherwise, the value it returns + replaces the keyword in the export output. + + `:export-citation' (mandatory for \"export\" capability) + + Function rendering citations. It is called with four arguments: a citation + object, the style, as a pair, the export back-end, as a symbol, and the + communication channel, as a property list. + + It is called on each citation object in the parse tree. It may return + a string, a parsed object, a secondary string, or nil. When it returns nil, + the citation is ignored. Otherwise, the value it returns replaces the + citation object in the export output. + + `:export-finalizer' + + Function called at the end of export process. It must accept six arguments: + the output, as a string, a list of citation keys used in the document, a + list of bibliography files, the expected bibliography style, as a string or + nil, the export back-end, as a symbol, and the communication channel, as a + property list. + + It must return a string, which will become the final output from the export + process, barring subsequent modifications from export filters. + + `:follow' + + Function called to follow a citation. It accepts two arguments, the + citation or citation reference object at point, and any prefix argument + received during interactive call of `org-open-at-point'. + + `:insert' + + Function called to insert a citation. It accepts two arguments, the + citation or citation reference object at point or nil, and any prefix + argument received. + + `:cite-styles' + + When the processor has export capability, the value can specify what cite + styles, variants, and their associated shortcuts are supported. It can be + useful information for completion or linting. + + The expected format is + + ((STYLE . SHORTCUTS) . VARIANTS)) + + where STYLE is a string, SHORTCUTS a list of strings or nil, and VARIANTS is + a list of pairs (VARIANT . SHORTCUTS), VARIANT being a string and SHORTCUTS + a list of strings or nil. + + The \"nil\" style denotes the processor fall-back style. It should have a + corresponding entry in the value. + +Return a non-nil value on a successful operation." + (declare (indent 1)) + (unless (and name (symbolp name)) + (error "Invalid processor name: %S" name)) + (when (org-cite--get-processor name) + (org-cite-unregister-processor name)) + (push (apply #'org-cite--make-processor :name name body) + org-cite--processors)) + +(defun org-cite-unregister-processor (name) + "Unregister citation processor NAME. +NAME is a symbol. Raise an error if processor is not registered. +Return a non-nil value on a successful operation." + (unless (and name (symbolp name)) + (error "Invalid processor name: %S" name)) + (pcase (org-cite--get-processor name) + ('nil (error "Processor %S not registered" name)) + (processor + (setq org-cite--processors (delete processor org-cite--processors)))) + t) + +(defun org-cite-processor-has-capability-p (processor capability) + "Return non-nil if PROCESSOR is able to handle CAPABILITY. +PROCESSOR is the name of a cite processor, as a symbol. CAPABILITY is +`activate', `export', `follow', or `insert'." + (let ((p (org-cite--get-processor processor))) + (pcase capability + ((guard (not p)) nil) ;undefined processor + ('activate (functionp (org-cite-processor-activate p))) + ('export (functionp (org-cite-processor-export-citation p))) + ('follow (functionp (org-cite-processor-follow p))) + ('insert (functionp (org-cite-processor-insert p))) + (other (error "Invalid capability: %S" other))))) + + +;;; Internal functions +(defun org-cite--set-post-blank (datum blanks) + "Set `:post-blank' property from element or object before DATUM to BLANKS. +DATUM is an element or object. BLANKS is an integer. DATUM is modified +by side-effect." + (if (not (eq 'plain-text (org-element-type datum))) + (org-element-put-property datum :post-blank blanks) + ;; Remove any blank from string before DATUM so it is exported + ;; with exactly BLANKS white spaces. + (org-element-set-element + datum + (replace-regexp-in-string + "[ \t\n]*\\'" (make-string blanks ?\s) datum)))) + +(defun org-cite--set-previous-post-blank (datum blanks info) + "Set `:post-blank' property from element or object before DATUM to BLANKS. +DATUM is an element or object. BLANKS is an integer. INFO is the export +state, as a property list. Previous element or object, if any, is modified by +side-effect." + (let ((previous (org-export-get-previous-element datum info))) + (when previous + (org-cite--set-post-blank previous blanks)))) + +(defun org-cite--insert-at-split (s citation n regexp) + "Split string S and insert CITATION object between the two parts. +S is split at beginning of match group N upon matching REGEXP against it. +This function assumes S precedes CITATION." + ;; When extracting the citation, remove white spaces before it, but + ;; preserve those after it. + (let ((post-blank (org-element-property :post-blank citation))) + (when (and post-blank (> post-blank 0)) + (org-element-insert-before (make-string post-blank ?\s) citation))) + (org-element-insert-before + (org-element-put-property (org-element-extract-element citation) + :post-blank 0) + s) + (string-match regexp s) + (let* ((split (match-beginning n)) + (first-part (substring s nil split)) + ;; Remove trailing white spaces as they are before the + ;; citation. + (last-part + (replace-regexp-in-string (rx (1+ (any blank ?\n)) string-end) + "" + (substring s split)))) + (when (org-string-nw-p first-part) + (org-element-insert-before first-part citation)) + (org-element-set-element s last-part))) + +(defun org-cite--move-punct-before (punct citation s info) + "Move punctuation PUNCT before CITATION object. +String S contains PUNCT. The function assumes S follows CITATION. +Parse tree is modified by side-effect." + (if (equal s punct) + (org-element-extract-element s) ;it would be empty anyway + (org-element-set-element s (substring s (length punct)))) + ;; Remove blanks before citation. + (org-cite--set-previous-post-blank citation 0 info) + (org-element-insert-before + ;; Blanks between citation and punct are now before punct and + ;; citation. + (concat (make-string (or (org-element-property :post-blank citation) 0) ?\s) + punct) + citation)) + +(defun org-cite--parse-as-plist (s) + "Parse string S as a property list. +Values are always strings. Return nil if S is nil." + (cond + ((null s) nil) + ((stringp s) + (with-temp-buffer + (save-excursion (insert s)) + (skip-chars-forward " \t") + (let ((results nil) + (value-flag nil)) + (while (not (eobp)) + (pcase (char-after) + (?: + (push (read (current-buffer)) results) + (setq value-flag t)) + ((guard (not value-flag)) + (skip-chars-forward "^ \t")) + (?\" + (let ((origin (point))) + (condition-case _ + (progn + (read (current-buffer)) + (push (buffer-substring (1+ origin) (1- (point))) results)) + (end-of-file + (goto-char origin) + (skip-chars-forward "^ \t") + (push (buffer-substring origin (point)) results))) + (setq value-flag nil))) + (_ + (let ((origin (point))) + (skip-chars-forward "^ \t") + (push (buffer-substring origin (point)) results) + (setq value-flag nil)))) + (skip-chars-forward " \t")) + (nreverse results)))) + (t (error "Invalid argument type: %S" s)))) + +(defun org-cite--get-note-rule (info) + "Return punctuation rule according to language used for export. + +INFO is the export state, as a property list. + +Rule is found according to the language used for export and +`org-cite-note-rules', which see. + +If there is no rule matching current language, the rule defaults +to (adaptive outside after)." + (let* ((language-tags + ;; Normalize language as a language-region tag, as described + ;; in RFC 4646. + (pcase (split-string (plist-get info :language) "[-_]") + (`(,language) + (list language + (or (cdr (assoc language org-cite--default-region-alist)) + language))) + (`(,language ,region) + (list language region)) + (other + (error "Invalid language identifier: %S" other)))) + (language-region (mapconcat #'downcase language-tags "-")) + (language (car language-tags))) + (or (cdr (assoc language-region org-cite-note-rules)) + (cdr (assoc language org-cite-note-rules)) + '(adaptive outside after)))) + + +;;; Generic tools +(defun org-cite-list-bibliography-files () + "List all bibliography files defined in the buffer." + (delete-dups + (append (mapcar (lambda (value) + (pcase value + (`(,f . ,d) + (expand-file-name (org-strip-quotes f) d)))) + (pcase (org-collect-keywords + '("BIBLIOGRAPHY") nil '("BIBLIOGRAPHY")) + (`(("BIBLIOGRAPHY" . ,pairs)) pairs))) + org-cite-global-bibliography))) + +(defun org-cite-get-references (citation &optional keys-only) + "Return citations references contained in CITATION object. + +When optional argument KEYS-ONLY is non-nil, return the references' keys, as a +list of strings. + +Assume CITATION object comes from either a full parse tree, e.g., during export, +or from the current buffer." + (let ((contents (org-element-contents citation))) + (cond + ((null contents) + (org-with-point-at (org-element-property :contents-begin citation) + (narrow-to-region (point) (org-element-property :contents-end citation)) + (let ((references nil)) + (while (not (eobp)) + (let ((reference (org-element-citation-reference-parser))) + (goto-char (org-element-property :end reference)) + (push (if keys-only + (org-element-property :key reference) + reference) + references))) + (nreverse references)))) + (keys-only (mapcar (lambda (r) (org-element-property :key r)) contents)) + (t contents)))) + +(defun org-cite-boundaries (citation) + "Return the beginning and end strict position of CITATION. +Returns a (BEG . END) pair." + (let ((beg (org-element-property :begin citation)) + (end (org-with-point-at (org-element-property :end citation) + (skip-chars-backward " \t") + (point)))) + (cons beg end))) + +(defun org-cite-key-boundaries (reference) + "Return citation REFERENCE's key boundaries as buffer positions. +The function returns a pair (START . END) where START and END denote positions +in the current buffer. Positions include leading \"@\" character." + (org-with-point-at (org-element-property :begin reference) + (let ((end (org-element-property :end reference))) + (re-search-forward org-element-citation-key-re end t) + (cons (match-beginning 0) (match-end 0))))) + +(defun org-cite-supported-styles (&optional processors) + "List of supported citation styles and variants. + +Supported styles are those handled by export processors from +`org-cite-export-processors', or in PROCESSORS, as a list of symbols, +when non-nil. + +Return value is a list with the following items: + + ((STYLE . SHORTCUTS) . VARIANTS)) + +where STYLE is a string, SHORTCUTS a list of strings, and VARIANTS is a list of +pairs (VARIANT . SHORTCUTS), VARIANT being a string and SHORTCUTS a list of +strings." + (let ((collection + (seq-mapcat + (lambda (name) + (org-cite-processor-cite-styles (org-cite--get-processor name))) + (or processors + (mapcar (pcase-lambda (`(,_ . (,name . ,_))) name) + org-cite-export-processors)))) + (result nil)) + ;; Merge duplicate styles. Each style full name is guaranteed to + ;; be unique, and associated to all shortcuts and all variants in + ;; the initial collection. + (pcase-dolist (`((,style . ,shortcuts) . ,variants) collection) + (let ((entry (assoc style result))) + (if (not entry) + (push (list style shortcuts variants) result) + (setf (nth 1 entry) + (seq-uniq (append shortcuts (nth 1 entry)))) + (setf (nth 2 entry) + (append variants (nth 2 entry)))))) + ;; Return value with the desired format. + (nreverse + (mapcar (pcase-lambda (`(,style ,shortcuts ,variants)) + (cons (cons style (nreverse shortcuts)) + ;; Merge variant shortcuts. + (let ((result nil)) + (pcase-dolist (`(,variant . ,shortcuts) variants) + (let ((entry (assoc variant result))) + (if (not entry) + (push (cons variant shortcuts) result) + (setf (cdr entry) + (seq-uniq (append shortcuts (cdr entry))))))) + result))) + result)))) + +(defun org-cite-delete-citation (datum) + "Delete citation or citation reference DATUM. +When removing the last reference, also remove the whole citation." + (pcase (org-element-type datum) + ('citation + (pcase-let* ((`(,begin . ,end) (org-cite-boundaries datum)) + (pos-before-blank + (org-with-point-at begin + (skip-chars-backward " \t") + (point))) + (pos-after-blank (org-element-property :end datum)) + (first-on-line? + (= pos-before-blank (line-beginning-position))) + (last-on-line? + (= pos-after-blank (line-end-position)))) + (cond + ;; The citation is alone on its line. Remove the whole line. + ;; Do not leave it blank as it might break a surrounding + ;; paragraph. + ((and first-on-line? last-on-line?) + (delete-region (line-beginning-position) (line-beginning-position 2))) + ;; When the citation starts the line, preserve indentation. + (first-on-line? (delete-region begin pos-after-blank)) + ;; When the citation ends the line, remove any trailing space. + (last-on-line? (delete-region pos-before-blank (line-end-position))) + ;; Otherwise, delete blanks before the citation. + ;; Nevertheless, make sure there is at least one blank left, + ;; so as to not splice unrelated surroundings. + (t + (delete-region pos-before-blank end) + (when (= pos-after-blank end) + (org-with-point-at pos-before-blank (insert " "))))))) + ('citation-reference + (let* ((citation (org-element-property :parent datum)) + (references (org-cite-get-references citation)) + (begin (org-element-property :begin datum)) + (end (org-element-property :end datum))) + (cond + ;; Single reference. + ((= 1 (length references)) + (org-cite-delete-citation citation)) + ;; First reference, no prefix. + ((and (= begin (org-element-property :contents-begin citation)) + (not (org-element-property :prefix citation))) + (org-with-point-at (org-element-property :begin datum) + (skip-chars-backward " \t") + (delete-region (point) end))) + ;; Last reference, no suffix. + ((and (= end (org-element-property :contents-end citation)) + (not (org-element-property :suffix citation))) + (delete-region (1- begin) (1- (cdr (org-cite-boundaries citation))))) + ;; Somewhere in-between. + (t + (delete-region begin end))))) + (other + (error "Invalid object type: %S" other)))) + + +;;; Tools only available during export +(defun org-cite-citation-style (citation info) + "Return citation style used for CITATION object. + +Style is a pair (NAME . VARIANT) where NAME and VARIANT are strings or nil. +A nil NAME means the default style for the current processor should be used. + +INFO is a plist used as a communication channel." + (let* ((separate + (lambda (s) + (cond + ((null s) (cons nil nil)) + ((not (string-match "/" s)) (cons s nil)) + (t (cons (substring s nil (match-beginning 0)) + (org-string-nw-p (substring s (match-end 0)))))))) + (local (funcall separate (org-element-property :style citation))) + (global + (funcall separate (pcase (plist-get info :cite-export) + (`(,_ ,_ ,style) style) + (_ nil))))) + (cond + ((org-string-nw-p (car local)) + (cons (org-not-nil (car local)) (cdr local))) + (t + (cons (org-not-nil (car global)) + (or (cdr local) (cdr global))))))) + +(defun org-cite-bibliography-style (info) + "Return expected bibliography style. +INFO is a plist used as a communication channel." + (pcase (plist-get info :cite-export) + (`(,_ ,style ,_) style) + (_ nil))) + +(defun org-cite-bibliography-properties (keyword) + "Return properties associated to \"print_bibliography\" KEYWORD object. +Return value is a property list." + (org-cite--parse-as-plist (org-element-property :value keyword))) + +(defun org-cite-list-citations (info) + "List citations in the exported document. +Citations are ordered by appearance in the document, when following footnotes. +INFO is the export communication channel, as a property list." + (or (plist-get info :citations) + (letrec ((cites nil) + (search-cites + (lambda (data) + (org-element-map data '(citation footnote-reference) + (lambda (datum) + (pcase (org-element-type datum) + ('citation (push datum cites)) + ;; Do not force entering inline definitions, since + ;; `org-element-map' is going to enter it anyway. + ((guard (eq 'inline (org-element-property :type datum)))) + (_ + (funcall search-cites + (org-export-get-footnote-definition datum info))))) + info nil 'footnote-definition t)))) + (funcall search-cites (plist-get info :parse-tree)) + (let ((result (nreverse cites))) + (plist-put info :citations result) + result)))) + +(defun org-cite-list-keys (info) + "List citation keys in the exported document. +Keys are ordered by first appearance in the document, when following footnotes. +Duplicate keys are removed. INFO is the export communication channel, as a +property list." + (delete-dups + (org-element-map (org-cite-list-citations info) 'citation-reference + (lambda (r) (org-element-property :key r)) + info))) + +(defun org-cite-key-number (key info &optional predicate) + "Return number associated to string KEY. + +INFO is the export communication channel, as a property list. + +Optional argument PREDICATE is called with two keys, and returns non-nil +if the first reference should sort before the second. When nil, references +are sorted in order cited." + (let* ((keys (org-cite-list-keys info)) + (sorted-keys (if (functionp predicate) + (sort keys predicate) + keys)) + (position (seq-position sorted-keys key #'string-equal))) + (and (integerp position) + (1+ position)))) + +(defun org-cite-inside-footnote-p (citation &optional strict) + "Non-nil when CITATION object is contained within a footnote. + +When optional argument STRICT is non-nil, return t only if CITATION represents +the sole contents of the footnote, e.g., after calling `org-cite-wrap-citation'. + +When non-nil, the return value if the footnote container." + (let ((footnote + (org-element-lineage citation + '(footnote-definition footnote-reference)))) + (and footnote + (or (not strict) + (equal (org-element-contents (org-element-property :parent citation)) + (list citation))) + ;; Return value. + footnote))) + +(defun org-cite-wrap-citation (citation info) + "Wrap an anonymous inline footnote around CITATION object in the parse tree. + +INFO is the export state, as a property list. + +White space before the citation, if any, are removed. The parse tree is +modified by side-effect." + (let ((footnote + (list 'footnote-reference + (list :label nil + :type 'inline + :contents-begin (org-element-property :begin citation) + :contents-end (org-element-property :end citation) + :post-blank (org-element-property :post-blank citation))))) + ;; Remove any white space before citation. + (org-cite--set-previous-post-blank citation 0 info) + ;; Footnote swallows citation. + (org-element-insert-before footnote citation) + (org-element-adopt-elements footnote + (org-element-extract-element citation)))) + +(defun org-cite-adjust-note (citation info &optional rule punct) + "Adjust note number location for CITATION object, and punctuation around it. + +INFO is the export state, as a property list. + +Optional argument PUNCT is a list of punctuation marks to be considered. +When nil, it defaults to `org-cite-punctuation-marks'. + +Parse tree is modified by side-effect. + +Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on +the same object, call `org-cite-adjust-punctuation' first." + (when org-cite-adjust-note-numbers + (pcase-let* ((rule (or rule (org-cite--get-note-rule info))) + (punct-re (regexp-opt (or punct org-cite-punctuation-marks))) + (previous-punct-re + (rx (opt (group (0+ (any blank ?\n)) (regexp punct-re))) + (opt (0+ (any blank ?\n)) (group ?\")) + (opt (group (1+ (any blank ?\n)))) + string-end)) + (next-punct-re + (rx string-start + (group (0+ (any blank ?\n)) (regexp punct-re)))) + (next (org-export-get-next-element citation info)) + (final-punct + (and (stringp next) + (string-match next-punct-re next) + (match-string 1 next))) + (previous + ;; Find the closest terminal object. Consider + ;; citation, subscript and superscript objects as + ;; terminal. + (org-last + (org-element-map (org-export-get-previous-element citation info) + '(citation code entity export-snippet footnote-reference + line-break latex-fragment link plain-text + radio-target statistics-cookie timestamp + verbatim) + #'identity info nil '(citation subscript superscript)))) + (`(,punct ,quote ,spacing) + (and (stringp previous) + (string-match previous-punct-re previous) + (list (match-string 1 previous) + (match-string 2 previous) + (match-string 3 previous))))) + ;; Bail you when there is no quote and either no punctuation, or + ;; punctuation on both sides. + (when (or quote (org-xor punct final-punct)) + ;; Phase 1: handle punctuation rule. + (pcase rule + ((guard (not quote)) nil) + ;; Move punctuation inside. + (`(,(or `inside (and `adaptive (guard (not spacing)))) . ,_) + ;; This only makes sense if there is a quotation before the + ;; citation that does not end with some punctuation. + (when (and (not punct) final-punct) + ;; Quote guarantees there is a string object before + ;; citation. Likewise, any final punctuation guarantees + ;; there is a string object following citation. + (let ((new-prev + (replace-regexp-in-string + previous-punct-re + (concat final-punct "\"") previous nil nil 2)) + (new-next + (replace-regexp-in-string + (rx string-start (literal final-punct)) + "" next))) + (org-element-set-element previous new-prev) + (org-element-set-element next new-next) + (setq previous new-prev) + (setq next new-next) + (setq punct final-punct) + (setq final-punct nil)))) + ;; Move punctuation outside. + (`(,(or `outside (and `adaptive (guard spacing))) . ,_) + ;; This is only meaningful if there is some inner + ;; punctuation and no final punctuation already. + (when (and punct (not final-punct)) + ;; Inner punctuation guarantees there is text object + ;; before the citation. However, there is no information + ;; about the object following citation, if any. + ;; Therefore, we handle all the possible cases (string, + ;; other type, or none). + (let ((new-prev + (replace-regexp-in-string + previous-punct-re "" previous nil nil 1)) + (new-next (if (stringp next) (concat punct next) punct))) + (org-element-set-element previous new-prev) + (cond + ((stringp next) + (org-element-set-element next new-next)) + (next + (org-element-insert-before new-next next)) + (t + (org-element-adopt-elements + (org-element-property :parent citation) + new-next))) + (setq previous new-prev) + (setq next new-next) + (setq final-punct punct) + (setq punct nil)))) + (_ + (error "Invalid punctuation rule: %S" rule)))) + ;; Phase 2: move citation to its appropriate location. + ;; + ;; First transform relative citation location into a definitive + ;; location, according to the surrounding punctuation. + (pcase rule + (`(,punctuation same ,order) + (setf rule + (list punctuation + (cond + ;; When there is punctuation on both sides, the + ;; citation is necessarily on the outside. + ((and punct final-punct) 'outside) + (punct 'inside) + (final-punct 'outside) + ;; No punctuation: bail out on next step. + (t nil)) + order)))) + (pcase rule + (`(,_ nil ,_) nil) + (`(,_ inside after) + ;; Citation has to be moved after punct, if there is + ;; a quotation mark, or after final punctuation. + (cond + (quote + (org-cite--insert-at-split previous citation 2 previous-punct-re)) + (final-punct + (org-cite--move-punct-before final-punct citation next info)) + ;; There is only punct, and we're already after it. + (t nil))) + (`(,_ inside before) + ;; Citation is already behind final-punct, so only consider + ;; other locations. + (when (or punct quote) + (org-cite--insert-at-split previous citation 0 previous-punct-re))) + (`(,_ outside after) + ;; Citation is already after any punct or quote. It can only + ;; move past final punctuation, if there is one. + (when final-punct + (org-cite--move-punct-before final-punct citation next info))) + (`(,_ outside before) + ;; The only non-trivial case is when citation follows punct + ;; without a quote. + (when (and punct (not quote)) + (org-cite--insert-at-split previous citation 0 previous-punct-re))) + (_ + (error "Invalid punctuation rule: %S" rule)))))) + + +;;; Tools generating or operating on parsed data +(defun org-cite-parse-elements (s) + "Parse string S as a list of Org elements. +The return value is suitable as a replacement for a \"print_bibliography\" keyword. +As a consequence, the function raises an error if S contains a headline." + (with-temp-buffer + (insert s) + (pcase (org-element-contents (org-element-parse-buffer)) + ('nil nil) + (`(,(and section (guard (eq 'section (org-element-type section))))) + (org-element-contents section)) + (_ + (error "Headlines cannot replace a keyword"))))) + +(defun org-cite-parse-objects (s &optional affix) + "Parse string S as a secondary string. + +The return value is suitable as a replacement for a citation object. + +When optional argument AFFIX is non-nil, restrict the set of allowed object +types to match the contents of a citation affix." + (org-element-parse-secondary-string + s (org-element-restriction (if affix 'citation-reference 'paragraph)))) + +(defun org-cite-make-paragraph (&rest data) + "Return a paragraph element containing DATA. +DATA are strings, objects or secondary strings." + (apply #'org-element-create 'paragraph nil (apply #'org-cite-concat data))) + +(defun org-cite-emphasize (type &rest data) + "Apply emphasis TYPE on DATA. +TYPE is a symbol among `bold', `italic', `strike-through' and `underline'. +DATA are strings, objects or secondary strings. Return an object of type TYPE." + (declare (indent 1)) + (unless (memq type '(bold italic strike-through underline)) + (error "Wrong emphasis type: %S" type)) + (apply #'org-element-create type nil (apply #'org-cite-concat data))) + +(defun org-cite-concat (&rest data) + "Concatenate all the DATA arguments and make the result a secondary string. +Each argument may be a string, an object, or a secondary string." + (let ((results nil)) + (dolist (datum (reverse data)) + (pcase datum + ('nil nil) + ;; Element or object. + ((pred org-element-type) (push datum results)) + ;; Secondary string. + ((pred consp) (setq results (append datum results))) + (_ + (signal + 'wrong-type-argument + (list (format "Argument is not a string or a secondary string: %S" + datum)))))) + results)) + +(defun org-cite-mapconcat (function data separator) + "Apply FUNCTION to each element of DATA, and return a secondary string. + +In between each pair of results, stick SEPARATOR, which may be a string, +an object, or a secondary string. FUNCTION must be a function of one argument, +and must return either a string, an object, or a secondary string." + (and data + (let ((result (list (funcall function (car data))))) + (dolist (datum (cdr data)) + (setq result + (org-cite-concat result separator (funcall function datum)))) + result))) + + +;;; Internal interface with fontification (activate capability) +(defun org-cite-fontify-default (datum) + "Fontify DATUM with `org-cite' and `org-cite-key' face. +DATUM is a citation object, or a citation reference. In any case, apply +`org-cite' face on the whole citation, and `org-cite-key' face on each key." + (let* ((cite (if (eq 'citation-reference (org-element-type datum)) + (org-element-property :parent datum) + datum)) + (beg (org-element-property :begin cite)) + (end (org-with-point-at (org-element-property :end cite) + (skip-chars-backward " \t") + (point)))) + (add-text-properties beg end '(font-lock-multiline t)) + (add-face-text-property beg end 'org-cite) + (dolist (reference (org-cite-get-references cite)) + (let ((boundaries (org-cite-key-boundaries reference))) + (add-face-text-property (car boundaries) (cdr boundaries) + 'org-cite-key))))) + +(defun org-cite-activate (limit) + "Activate citations from up to LIMIT buffer position. +Each citation encountered is activated using the appropriate function +from the processor set in `org-cite-activate-processor'." + (let ((name org-cite-activate-processor)) + (let ((activate + (or (and name + (org-cite-processor-has-capability-p name 'activate) + (org-cite-processor-activate (org-cite--get-processor name))) + #'org-cite-fontify-default))) + (while (re-search-forward org-element-citation-prefix-re limit t) + (let ((cite (org-with-point-at (match-beginning 0) + (org-element-citation-parser)))) + (when cite (save-excursion (funcall activate cite)))))))) + + +;;; Internal interface with Org Export library (export capability) +(defun org-cite-store-bibliography (info) + "Store bibliography in the communication channel. + +Bibliography is stored as a list of absolute file names in the `:bibliography' +property. + +INFO is the communication channel, as a plist. It is modified by side-effect." + (plist-put info :bibliography (org-cite-list-bibliography-files))) + +(defun org-cite-store-export-processor (info) + "Store export processor in the `:cite-export' property during export. + +Export processor is stored as a triplet, or nil. + +When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) where +NAME is a symbol, whereas BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings, +or nil. + +INFO is the communication channel, as a plist. It is modified by side-effect." + (let* ((err + (lambda (s) + (user-error "Invalid cite export processor definition: %S" s))) + (processor + (pcase (plist-get info :cite-export) + ((or "" `nil) nil) + ;; Value is a string. It comes from a "cite_export" + ;; keyword. It may contain between 1 and 3 tokens, the + ;; first one being a symbol and the other (optional) two, + ;; strings. + ((and (pred stringp) s) + (with-temp-buffer + (save-excursion (insert s)) + (let ((result (list (read (current-buffer))))) + (dotimes (_ 2) + (skip-chars-forward " \t") + (cond + ((eobp) (push nil result)) + ((char-equal ?\" (char-after)) + (condition-case _ + (push (org-not-nil (read (current-buffer))) result) + (error (funcall err s)))) + (t + (let ((origin (point))) + (skip-chars-forward "^ \t") + (push (org-not-nil (buffer-substring origin (point))) + result))))) + (unless (eobp) (funcall err s)) + (nreverse result)))) + ;; Value is an alist. It must come from + ;; `org-cite-export-processors' variable. Find the most + ;; appropriate processor according to current export + ;; back-end. + ((and (pred consp) alist) + (let* ((backend (plist-get info :back-end)) + (candidates + ;; Limit candidates to processors associated to + ;; back-ends derived from or equal to the current + ;; one. + (sort (seq-filter + (pcase-lambda (`(,key . ,_)) + (org-export-derived-backend-p backend key)) + alist) + (lambda (a b) + (org-export-derived-backend-p (car a) (car b)))))) + ;; Select the closest candidate, or fallback to t. + (pcase (or (car candidates) (assq t alist)) + ('nil nil) + (`(,_ . ,p) + ;; Normalize value by turning it into a triplet. + (pcase p + (`(,(pred symbolp)) + (append p (list nil nil))) + (`(,(pred symbolp) ,(pred string-or-null-p)) + (append p (list nil))) + (`(,(pred symbolp) + ,(pred string-or-null-p) + ,(pred string-or-null-p)) + p) + (_ (funcall err p)))) + (other (funcall err (cdr other)))))) + (other (funcall err other))))) + (pcase processor + ('nil nil) + (`(,name . ,_) + (cond + ((not (org-cite--get-processor name)) + (user-error "Unknown processor %S" name)) + ((not (org-cite-processor-has-capability-p name 'export)) + (user-error "Processor %S is unable to handle citation export" name))))) + (plist-put info :cite-export processor))) + +(defun org-cite-export-citation (citation _ info) + "Export CITATION object according to INFO property list. +This function delegates the export of the current citation to the +selected citation processor." + (pcase (plist-get info :cite-export) + ('nil nil) + (`(,p ,_ ,_) + (funcall (org-cite-processor-export-citation (org-cite--get-processor p)) + citation + (org-cite-citation-style citation info) + (plist-get info :back-end) + info)) + (other (error "Invalid `:cite-export' value: %S" other)))) + +(defun org-cite-export-bibliography (keyword _ info) + "Return bibliography associated to \"print_bibliography\" KEYWORD. +BACKEND is the export back-end, as a symbol. INFO is a plist +used as a communication channel." + (pcase (plist-get info :cite-export) + ('nil nil) + (`(,p ,_ ,_) + (let ((export-bibilography + (org-cite-processor-export-bibliography + (org-cite--get-processor p)))) + (when export-bibilography + (funcall export-bibilography + (org-cite-list-keys info) + (plist-get info :bibliography) + (org-cite-bibliography-style info) + (org-cite-bibliography-properties keyword) + (plist-get info :back-end) + info)))) + (other (error "Invalid `:cite-export' value: %S" other)))) + +(defun org-cite-process-citations (info) + "Replace all citations in the parse tree. +INFO is the communication channel, as a plist. Parse tree is modified +by side-effect." + (dolist (cite (org-cite-list-citations info)) + (let ((replacement (org-cite-export-citation cite nil info)) + (blanks (or (org-element-property :post-blank cite) 0))) + (if (null replacement) + ;; Before removing the citation, transfer its `:post-blank' + ;; property to the object before, if any. + (org-cite--set-previous-post-blank cite blanks info) + ;; We want to be sure any non-note citation is preceded by + ;; a space. This is particularly important when using + ;; `adaptive' note rule. See `org-cite-note-rules'. + (unless (org-cite-inside-footnote-p cite t) + (org-cite--set-previous-post-blank cite 1 info)) + (pcase replacement + ;; String. + ((pred stringp) + ;; Handle `:post-blank' before replacing value. + (let ((output (concat (org-trim replacement) + (make-string blanks ?\s)))) + (org-element-insert-before (org-export-raw-string output) cite))) + ;; Single element. + (`(,(pred symbolp) . ,_) + (org-cite--set-post-blank replacement blanks) + (org-element-insert-before replacement cite)) + ;; Secondary string: splice objects at cite's place. + ;; Transfer `:post-blank' to the last object. + ((pred consp) + (let ((last nil)) + (dolist (datum replacement) + (setq last datum) + (org-element-insert-before datum cite)) + (org-cite--set-post-blank last blanks))) + (_ + (error "Invalid return value from citation export processor: %S" + replacement)))) + (org-element-extract-element cite)))) + +(defun org-cite-process-bibliography (info) + "Replace all \"print_bibliography\" keywords in the parse tree. + +INFO is the communication channel, as a plist. Parse tree is modified +by side effect." + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (keyword) + (when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword)) + (let ((replacement (org-cite-export-bibliography keyword nil info)) + (blanks (or (org-element-property :post-blank keyword) 0))) + (pcase replacement + ;; Before removing the citation, transfer its + ;; `:post-blank' property to the element before, if any. + ('nil + (org-cite--set-previous-post-blank keyword blanks info) + (org-element-extract-element keyword)) + ;; Handle `:post-blank' before replacing keyword with string. + ((pred stringp) + (let ((output (concat (org-element-normalize-string replacement) + (make-string blanks ?\n)))) + (org-element-set-element keyword (org-export-raw-string output)))) + ;; List of elements: splice contents before keyword and + ;; remove the latter. Transfer `:post-blank' to last + ;; element. + ((and `(,(pred listp) . ,_) contents) + (let ((last nil)) + (dolist (datum contents) + (setq last datum) + (org-element-insert-before datum keyword)) + (org-cite--set-post-blank last blanks) + (org-element-extract-element keyword))) + ;; Single element: replace the keyword. + (`(,(pred symbolp) . ,_) + (org-cite--set-post-blank replacement blanks) + (org-element-set-element keyword replacement)) + (_ + (error "Invalid return value from citation export processor: %S" + replacement)))))) + info)) + +(defun org-cite-finalize-export (output info) + "Finalizer for export process. +OUTPUT is the full output of the export process. INFO is the communication +channel, as a property list." + (pcase (plist-get info :cite-export) + ('nil output) + (`(,p ,_ ,_) + (let ((finalizer + (org-cite-processor-export-finalizer (org-cite--get-processor p)))) + (if (not finalizer) + output + (funcall finalizer + output + (org-cite-list-keys info) + (plist-get info :bibliography) + (org-cite-bibliography-style info) + (plist-get info :back-end) + info)))) + (other (error "Invalid `:cite-export' value: %S" other)))) + + +;;; Internal interface with `org-open-at-point' (follow capability) +(defun org-cite-follow (datum arg) + "Follow citation or citation-reference DATUM. +Following is done according to the processor set in `org-cite-follow-processor'. +ARG is the prefix argument received when calling `org-open-at-point', or nil." + (let ((name org-cite-follow-processor)) + (cond + ((null name) + (user-error "No processor set to follow citations")) + ((not (org-cite--get-processor name)) + (user-error "Unknown processor %S" name)) + ((not (org-cite-processor-has-capability-p name 'follow)) + (user-error "Processor %S cannot follow citations" name)) + (t + (let ((follow (org-cite-processor-follow (org-cite--get-processor name)))) + (funcall follow datum arg)))))) + + +;;; Meta-command for citation insertion (insert capability) +(defun org-cite--allowed-p (context) + "Non-nil when a citation can be inserted at point." + (let* ((type (org-element-type context))) + (cond + ;; No citation in attributes. + ((let ((post (org-element-property :post-affiliated context))) + (and post (< (point) post))) + nil) + ;; Paragraphs and blank lines at top of document are fine. + ((memq type '(nil paragraph))) + ;; So are contents of verse blocks. + ((eq type 'verse-block) + (and (>= (point) (org-element-property :contents-begin context)) + (< (point) (org-element-property :contents-end context)))) + ;; In an headline or inlinetask, point must be either on the + ;; heading itself or on the blank lines below. + ((memq type '(headline inlinetask)) + (or (not (org-at-heading-p)) + (and (save-excursion + (beginning-of-line) + (and (let ((case-fold-search t)) + (not (looking-at-p "\\*+ END[ \t]*$"))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) + (match-beginning 4) + (>= (point) (match-beginning 4)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5)))))) + ;; White spaces after an object or blank lines after an element + ;; are OK. + ((>= (point) + (save-excursion (goto-char (org-element-property :end context)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class context) 'object) (point) + (line-beginning-position 2))))) + ;; Other elements are invalid. + ((eq (org-element-class context) 'element) nil) + ;; Just before object is fine. + ((= (point) (org-element-property :begin context))) + ;; Within recursive object too, but not in a link. + ((eq type 'link) nil) + ((eq type 'table-cell) + ;; :contents-begin is not reliable on empty cells, so special + ;; case it. + (<= (point) (org-element-property :contents-end context))) + ((let ((cbeg (org-element-property :contents-begin context)) + (cend (org-element-property :contents-end context))) + (and cbeg (>= (point) cbeg) (<= (point) cend))))))) + +(defun org-cite--insert-string-before (string reference) + "Insert STRING before citation REFERENCE object." + (org-with-point-at (org-element-property :begin reference) + (insert string ";"))) + +(defun org-cite--insert-string-after (string reference) + "Insert STRING after citation REFERENCE object." + (org-with-point-at (org-element-property :end reference) + ;; Make sure to move forward when we're inserting at point, so the + ;; insertion can happen multiple times. + (if (char-equal ?\; (char-before)) + (insert-before-markers string ";") + (insert-before-markers ";" string)))) + +(defun org-cite-make-insert-processor (select-key select-style) + "Build a function appropriate as an insert processor. + +SELECT-KEY is a function called with one argument. When it is nil, the function +should return a citation key as a string, or nil. Otherwise, the function +should return a list of such keys, or nil. The keys should not have any leading +\"@\" character. + +SELECT-STYLE is a function called without any argument. It should return a +style string, or nil. + +The return value is a function of two arguments: CONTEXT and ARG. CONTEXT is +either a citation reference, a citation object, or nil. ARG is a prefix +argument. + +The generated function inserts or edit a citation at point. More specifically, + + On a citation reference: + + - on the prefix or right before th \"@\" character, insert a new reference + before the current one, + - on the suffix, insert it after the reference, + - otherwise, update the cite key, preserving both affixes. + + When ARG is non-nil, remove the reference, possibly removing the whole + citation if it contains a single reference. + + On a citation object: + + - on the style part, offer to update it, + - on the global prefix, add a new reference before the first one, + - on the global suffix, add a new reference after the last one, + + Elsewhere, insert a citation at point. When ARG is non-nil, offer to complete + style in addition to references." + (unless (and (functionp select-key) (functionp select-style)) + (error "Wrong argument type(s)")) + (lambda (context arg) + (pcase (org-element-type context) + ;; When on a citation, check point is not on the blanks after it. + ;; Otherwise, consider we're after it. + ((and 'citation + (guard + (let ((boundaries (org-cite-boundaries context))) + (and (< (point) (cdr boundaries)) + (> (point) (car boundaries)))))) + ;; When ARG is non-nil, delete the whole citation. Otherwise, + ;; action depends on the point. + (if arg + (org-cite-delete-citation context) + (let* ((begin (org-element-property :begin context)) + (style-end (1- (org-with-point-at begin (search-forward ":"))))) + (if (>= style-end (point)) + ;; On style part, edit the style. + (let ((style-start (+ 5 begin)) + (style (funcall select-style))) + (unless style (user-error "Aborted")) + (org-with-point-at style-start + (delete-region style-start style-end) + (when (org-string-nw-p style) (insert "/" style)))) + ;; On an affix, insert a new reference before or after + ;; point. + (let* ((references (org-cite-get-references context)) + (key (concat "@" (funcall select-key nil)))) + (if (< (point) (org-element-property :contents-begin context)) + (org-cite--insert-string-before key (car references)) + (org-cite--insert-string-after key (org-last references)))))))) + ;; On a citation reference. If ARG is not nil, remove the + ;; reference. Otherwise, action depends on the point. + ((and 'citation-reference (guard arg)) (org-cite-delete-citation context)) + ('citation-reference + (pcase-let* ((`(,start . ,end) (org-cite-key-boundaries context)) + (key (concat "@" + (or (funcall select-key nil) + (user-error "Aborted"))))) + ;; Right before the "@" character, do not replace the reference + ;; at point, but insert a new one before it. It makes adding + ;; a new reference at the beginning easier in the following + ;; case: [cite:@key]. + (cond + ((>= start (point)) (org-cite--insert-string-before key context)) + ((<= end (point)) (org-cite--insert-string-after key context)) + (t + (org-with-point-at start + (delete-region start end) + (insert key)))))) + (_ + (let ((keys (funcall select-key t))) + (unless keys (user-error "Aborted")) + (insert + (format "[cite%s:%s]" + (if arg + (let ((style (funcall select-style))) + (if (org-string-nw-p style) + (concat "/" style) + "")) + "") + (mapconcat (lambda (k) (concat "@" k)) keys ";")))))))) + +(defun org-cite-insert (arg) + "Insert a citation at point. +Insertion is done according to the processor set in `org-cite-insert-processor'. +ARG is the prefix argument received when calling interactively the function." + (interactive "P") + (let ((name org-cite-insert-processor)) + (cond + ((null name) + (user-error "No processor set to follow citations")) + ((not (org-cite--get-processor name)) + (user-error "Unknown processor %S" name)) + ((not (org-cite-processor-has-capability-p name 'insert)) + (user-error "Processor %S cannot insert citations" name)) + (t + (let ((context (org-element-context)) + (insert (org-cite-processor-insert (org-cite--get-processor name)))) + (cond + ((memq (org-element-type context) '(citation citation-reference)) + (funcall insert context arg)) + ((org-cite--allowed-p context) + (funcall insert nil arg)) + (t + (user-error "Cannot insert a citation here")))))))) + +(provide 'org-cite) +(provide 'oc) +;;; oc.el ends here diff --git a/testing/lisp/test-oc.el b/testing/lisp/test-oc.el new file mode 100644 index 000000000..16e67ac73 --- /dev/null +++ b/testing/lisp/test-oc.el @@ -0,0 +1,1774 @@ +;;; test-oc.el --- Tests for Org Cite library -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Nicolas Goaziou + +;; Author: Nicolas Goaziou + +;; 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 . + +;;; Code: + +(require 'oc) +(require 'ox) +;; We need `org-test-with-parsed-data' macro. +(require 'test-ox "../testing/lisp/test-ox.el") + +(ert-deftest test-org-cite/register-processor () + "Test `org-cite-register-processor'." + ;; Default test. + (should + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name))) + ;; Handle duplicate processor. + (should + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name) + (org-cite-register-processor 'name))) + ;; Invalid name type. + (should-error (org-cite-register-processor "name")) + ;; Unknown property. + (should-error + (let ((org-cite--processors nil)) + (org-cite-register-processor :foo 'bar)))) + +(ert-deftest test-org-cite/unregister-processor () + "Test `org-cite-unregister-processor'." + ;; Default test. + (should-not + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name) + (org-cite-unregister-processor 'name) + org-cite--processors)) + ;; Error out with an unknown processor. + (should-error + (let ((org-cite--processors nil)) + (org-cite-unregister-processor 'name)))) + +(ert-deftest test-org-cite/inside-footnote-p () + "Test `org-cite-inside-footnote-p'." + ;; Regular tests. + (should + (org-test-with-parsed-data "[fn:1] [cite:@key]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t)))) + (should + (org-test-with-parsed-data "[fn::[cite:@key]]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t)))) + (should-not + (org-test-with-parsed-data "[cite:@key]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t)))) + (should + (org-test-with-parsed-data "[fn:1] Text.[cite:@key]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t)))) + (should + (org-test-with-parsed-data "[fn:1] [cite:@key]\n: fixed width" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t)))) + (should + (org-test-with-parsed-data "[fn:1] [cite:@key] " + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t)))) + ;; Test optional argument. + (should + (org-test-with-parsed-data "[fn:1] [cite:@key]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t) + t))) + (should-not + (org-test-with-parsed-data "[fn:1] See [cite:@key]." + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t) + t))) + (should + (org-test-with-parsed-data "[fn::[cite:@key]]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t) + t))) + (should-not + (org-test-with-parsed-data "[fn::See [cite:@key].]" + (org-cite-inside-footnote-p + (org-element-map tree 'citation #'identity info t) + t)))) + +(ert-deftest test-org-cite/processor-has-capability-p () + "Test `org-cite-processor-has-capability-p'." + ;; Unknown capability error. + (should-error + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :activate #'ignore) + (org-cite-processor-has-capability-p 'name 'unknown))) + ;; Test `activate' capability. + (should + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :activate #'ignore) + (org-cite-processor-has-capability-p 'name 'activate))) + (should-not + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :follow #'ignore) + (org-cite-processor-has-capability-p 'name 'activate))) + ;; Test `export' capability. + (should + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name + :export-bibliography #'ignore + :export-citation #'ignore) + (org-cite-processor-has-capability-p 'name 'export))) + (should + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :export-citation #'ignore) + (org-cite-processor-has-capability-p 'name 'export))) + (should-not + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :export-bibliography #'ignore) + (org-cite-processor-has-capability-p 'name 'export))) + ;; Test `follow' capability. + (should + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :follow #'ignore) + (org-cite-processor-has-capability-p 'name 'follow))) + (should-not + (let ((org-cite--processors nil)) + (org-cite-register-processor 'name :activate #'ignore) + (org-cite-processor-has-capability-p 'name 'follow))) + ;; Unknown processors have no capabilities. + (should-not (org-cite-processor-has-capability-p 'foo 'activate)) + (should-not (org-cite-processor-has-capability-p 'foo 'export)) + (should-not (org-cite-processor-has-capability-p 'foo 'follow))) + +(ert-deftest test-org-cite/get-references () + "Test `org-cite-get-references'." + ;; Return a list of citation reference objects. + (should + (equal '(citation-reference) + (org-test-with-temp-text "[cite:@a]" + (mapcar #'org-element-type + (org-cite-get-references (org-element-context)))))) + (should + (equal '("a") + (org-test-with-temp-text "[cite:@a]" + (mapcar (lambda (r) (org-element-property :key r)) + (org-cite-get-references (org-element-context)))))) + ;; Preserve order of references. + (should + (equal '("a" "b") + (org-test-with-temp-text "[cite:@a;@b]" + (mapcar (lambda (r) (org-element-property :key r)) + (org-cite-get-references (org-element-context)))))) + ;; Parse prefix and suffix. + (should + (equal '("a" "b") + (org-test-with-temp-text "[cite:prefix @a suffix;@b]" + (mapcar (lambda (r) (org-element-property :key r)) + (org-cite-get-references (org-element-context)))))) + (should + (equal '(("prefix ") nil) + (org-test-with-temp-text "[cite:prefix @a suffix;@b]" + (mapcar (lambda (r) (org-element-property :prefix r)) + (org-cite-get-references (org-element-context)))))) + (should + (equal '((" suffix") nil) + (org-test-with-temp-text "[cite:prefix @a suffix;@b]" + (mapcar (lambda (r) (org-element-property :suffix r)) + (org-cite-get-references (org-element-context)))))) + ;; Ignore common prefix and suffix. + (should + (equal '("a") + (org-test-with-temp-text "[cite:common prefix; @a ; common suffix]" + (mapcar (lambda (r) (org-element-property :key r)) + (org-cite-get-references (org-element-context)))))) + ;; Preserve buffer positions. + (should + (org-test-with-temp-text "[cite:@a] [cite:@b]" + (= (1+ (point)) + (org-element-property :begin + (car (org-cite-get-references (org-element-context))))))) + ;; Handle citation from a full parse tree. + (should + (equal '(1 2) + (org-test-with-temp-text "[cite:@a] [cite:@a;@b]" + (org-element-map (org-element-parse-buffer) 'citation + (lambda (c) (length (org-cite-get-references c))))))) + ;; Test optional argument. + (should + (equal '("a" "b") + (org-test-with-temp-text "[cite:@a;@b]" + (org-cite-get-references (org-element-context) t)))) + (should + (equal '("a" "b") + (org-test-with-temp-text "[cite:@a;@b]" + (org-element-map (org-element-parse-buffer) 'citation + (lambda (c) (org-cite-get-references c t)) nil t))))) + +(ert-deftest test-org-cite/key-boundaries () + "Test `org-cite-key-boundaries'." + (should + (equal "@key" + (org-test-with-temp-text "[cite:@key]" + (let ((boundaries (org-cite-key-boundaries (org-element-context)))) + (buffer-substring-no-properties + (car boundaries) + (cdr boundaries)))))) + (should + (equal "@key" + (org-test-with-temp-text "[cite:prefix @key]" + (let ((boundaries (org-cite-key-boundaries (org-element-context)))) + (buffer-substring-no-properties + (car boundaries) + (cdr boundaries)))))) + (should + (equal "@key" + (org-test-with-temp-text "[cite:@key suffix]" + (let ((boundaries (org-cite-key-boundaries (org-element-context)))) + (buffer-substring-no-properties + (car boundaries) + (cdr boundaries)))))) + (should + (equal "@key" + (org-test-with-temp-text "[cite:global ;@key]" + (let ((boundaries (org-cite-key-boundaries (org-element-context)))) + (buffer-substring-no-properties + (car boundaries) + (cdr boundaries)))))) + (should + (equal "@key" + (org-test-with-temp-text "[cite:@key; global]" + (let ((boundaries (org-cite-key-boundaries (org-element-context)))) + (buffer-substring-no-properties + (car boundaries) + (cdr boundaries))))))) + +(ert-deftest test-org-cite/supported-styles () + "Test `org-cite-supported-styles'." + ;; Default behavior is to use export processors. + (should + (equal '(((""))) + (let ((org-cite--processors nil) + (org-cite-export-processors '((t test)))) + (org-cite-register-processor 'test :cite-styles '((("")))) + (org-cite-supported-styles)))) + (should + (equal '((("foo" "f")) ((""))) + (let ((org-cite--processors nil) + (org-cite-export-processors '((t test)))) + (org-cite-register-processor 'test + :cite-styles '((("foo" "f")) (("")))) + (org-cite-supported-styles)))) + ;; Explicitly provide a processor. + (should + (equal '(((""))) + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test :cite-styles '((("")))) + (org-cite-supported-styles '(test))))) + ;; Merge style shortcuts. + (should + (equal '((("foo" "f" "g"))) + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test :cite-styles '((("foo" "f")))) + (org-cite-register-processor 'test2 :cite-styles '((("foo" "g")))) + (org-cite-supported-styles '(test test2))))) + ;; Merge style variants. + (should + (equal '((("foo") ("bar") ("baz"))) + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test + :cite-styles '((("foo") ("bar")))) + (org-cite-register-processor 'test2 + :cite-styles '((("foo") ("baz")))) + (org-cite-supported-styles '(test test2))))) + ;; Merge variant shortcuts. + (should + (equal '((("foo") ("bar" "b" "c"))) + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test + :cite-styles '((("foo") ("bar" "b")))) + (org-cite-register-processor 'test2 + :cite-styles '((("foo") ("bar" "c")))) + (org-cite-supported-styles '(test test2))))) + ;; Ignore duplicates. + (should + (equal '((("foo") ("bar"))) + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test + :cite-styles '((("foo") ("bar")))) + (org-cite-register-processor 'test2 + :cite-styles '((("foo") ("bar")))) + (org-cite-supported-styles '(test test2))))) + (should + (equal '((("foo") ("bar" "b"))) + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test + :cite-styles '((("foo") ("bar" "b")))) + (org-cite-register-processor 'test2 + :cite-styles '((("foo") ("bar" "b")))) + (org-cite-supported-styles '(test test2)))))) + +(ert-deftest test-org-cite/delete-citation () + "Test `org-cite-delete-citation'." + ;; Error when not on a citation or citation reference. + (should-error + (org-test-with-temp-text "Text" + (org-cite-delete-citation (org-element-context)))) + ;; When argument is a citation, delete it completely. Manage + ;; properly blanks around it. + (should + (equal "" + (org-test-with-temp-text "[cite:@key]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "Before After" + (org-test-with-temp-text "Before [cite:@key] After" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "Before After" + (org-test-with-temp-text "Before [cite:@key]After" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "Before After" + (org-test-with-temp-text "Before[cite:@key] After" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + ;; Ensure there is at least a blank to separate consecutive objects. + (should + (equal "Before After" + (org-test-with-temp-text "Before[cite:@key]After" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + ;; Remove trailing blanks when removing the citation. + (should + (equal "Before" + (org-test-with-temp-text "Before[cite:@key] " + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + ;; Preserve indentation if citation is at the beginning of the line. + (should + (equal " After" + (org-test-with-temp-text " [cite:@key] After" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + ;; When the citation is alone on a line, remove the whole line. + (should + (equal "Line 1\nLine 3" + (org-test-with-temp-text "Line 1\n[cite:@key]\nLine 3" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + ;; When there is only one citation reference object, remove the full + ;; citation. + (should + (equal "" + (org-test-with-temp-text "[cite:@key]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "" + (org-test-with-temp-text "[cite:pre @key post]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "" + (org-test-with-temp-text "[cite:pre; @key ;post]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + ;; Otherwise, remove the reference, including any affix. + (should + (equal "[cite:@before;@after]" + (org-test-with-temp-text "[cite:@before;@key;@after]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "[cite:@before;@after]" + (org-test-with-temp-text "[cite:@before;pre @key post;@after]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "[cite:@before]" + (org-test-with-temp-text "[cite:@before;@key]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "[cite:@before;post]" + (org-test-with-temp-text "[cite:@before;@key;post]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "[cite:@after]" + (org-test-with-temp-text "[cite:@key;@after]" + (org-cite-delete-citation (org-element-context)) + (buffer-string)))) + (should + (equal "[cite:pre;@after]" + (org-test-with-temp-text "[cite:pre;@key;@after]" + (org-cite-delete-citation (org-element-context)) + (buffer-string))))) + +(ert-deftest test-org-cite/list-bibliography-files () + "Test `org-cite-list-bibliography-files'." + (should + (equal '("/bibliography") + (org-test-with-temp-text "#+bibliography: /bibliography" + (let ((org-cite-global-bibliography nil)) + (org-cite-list-bibliography-files))))) + (should + (equal '("/bibliography") + (org-test-with-temp-text "#+bibliography: \"/bibliography\"" + (let ((org-cite-global-bibliography nil)) + (org-cite-list-bibliography-files))))) + (should + (equal '("/bibliography" "/other-bibliography") + (org-test-with-temp-text "#+bibliography: /bibliography" + (let ((org-cite-global-bibliography '("/other-bibliography"))) + (org-cite-list-bibliography-files))))) + (should + (equal '(t) + (org-test-with-temp-text "#+bibliography: ./bibliography" + (let ((org-cite-global-bibliography nil)) + (mapcar #'file-name-absolute-p (org-cite-list-bibliography-files)))))) + (should + (equal '("/bibliographyA" "/bibliographyB") + (org-test-with-temp-text + "#+bibliography: /bibliographyA\n#+bibliography: /bibliographyB" + (let ((org-cite-global-bibliography nil)) + (org-cite-list-bibliography-files))))) + (should + (equal '("/bibliographyA") + (org-test-with-temp-text + "#+bibliography: /bibliographyA\n#+bibliography: /bibliographyA" + (let ((org-cite-global-bibliography nil)) + (org-cite-list-bibliography-files)))))) + +(ert-deftest test-org-cite/bibliography-style () + "Test `org-cite-bibliography-style'." + ;; Extract style from global processor definition. + (should + (equal "a" + (catch :exit + (org-test-with-temp-text "#+print_bibliography:" + (let ((org-cite-export-processors '((t . (foo "a" "b")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-bibliography (lambda (_ _ s _ _ _) (throw :exit s)) + :export-citation #'ignore) + (org-export-as (org-export-create-backend))))))) + ;; Extract style from local processor definition. + (should + (equal "a" + (catch :exit + (org-test-with-temp-text + "#+cite_export: foo a b\n#+print_bibliography:" + (let ((org-cite-export-processors nil) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-bibliography (lambda (_ _ s _ _ _) (throw :exit s)) + :export-citation #'ignore) + (org-export-as (org-export-create-backend))))))) + (should + (equal "a b" + (catch :exit + (org-test-with-temp-text + "#+cite_export: foo \"a b\" c\n#+print_bibliography:" + (let ((org-cite-export-processors nil) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-bibliography (lambda (_ _ s _ _ _) (throw :exit s)) + :export-citation #'ignore) + (org-export-as (org-export-create-backend))))))) + ;; Test priority: first keyword, then local. + (should + (equal "local" + (catch :exit + (org-test-with-temp-text + "#+print_bibliography:\n#+cite_export: foo local a\n[cite:@a]" + (let ((org-cite-export-processors '((t . (foo "global" "b")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-bibliography (lambda (_ _ s _ _ _) (throw :exit s)) + :export-citation #'ignore) + (org-export-as (org-export-create-backend))))))) + ;; Explicit "nil" styles forces default style. + (should-not + (catch :exit + (org-test-with-temp-text + "#+print_bibliography:\n#+cite_export: foo nil a\n[cite:@a]" + (let ((org-cite-export-processors '((t . (foo "global" "b")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-bibliography (lambda (_ _ s _ _ _) (throw :exit s)) + :export-citation #'ignore) + (org-export-as (org-export-create-backend))))))) + +(ert-deftest test-org-cite/bibliography-properties () + "Test `org-cite-bibliography-properties'." + ;; Return nil without properties. + (should-not + (org-test-with-parsed-data "#+print_bibliography:" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t))) + ;; Regular tests. + (should + (equal + '(:key "value") + (org-test-with-parsed-data "#+print_bibliography: :key value" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t)))) + (should + (equal + '(:key "value" :key2 "value2") + (org-test-with-parsed-data "#+print_bibliography: :key value :key2 value2" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t)))) + ;; Allow empty values. + (should + (equal + '(:key) + (org-test-with-parsed-data "#+print_bibliography: :key" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t)))) + (should + (equal + '(:key "") + (org-test-with-parsed-data "#+print_bibliography: :key \"\"" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t)))) + ;; Allow space with double quotes. + (should + (equal + '(:key "space space") + (org-test-with-parsed-data "#+print_bibliography: :key \"space space\"" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t)))) + ;; Ignore spurious values. + (should + (equal + '(:key "space") + (org-test-with-parsed-data "#+print_bibliography: :key space space" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t)))) + ;; Gracefully handle incomplete quotations. + (should + (equal + '(:key "\"space" :key2 "value2") + (org-test-with-parsed-data "#+print_bibliography: :key \"space :key2 value2" + (org-element-map tree 'keyword + #'org-cite-bibliography-properties info t))))) + +(ert-deftest test-org-cite/citation-style () + "Test `org-cite-citation-style'." + ;; Extract style from global processor definition. + (should + (equal '("b") + (catch :exit + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite-export-processors '((t . (foo "a" "b")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("b" . "variant") + (catch :exit + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite-export-processors '((t . (foo "a" "b/variant")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + ;; Extract style from local processor definition. + (should + (equal '("b") + (catch :exit + (org-test-with-temp-text "#+cite_export: foo a b\n[cite:@a]" + (let ((org-cite-export-processors nil) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("b c") + (catch :exit + (org-test-with-temp-text "#+cite_export: foo a \"b c\"\n[cite:@a]" + (let ((org-cite-export-processors nil) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("b" . "variant") + (catch :exit + (org-test-with-temp-text "#+cite_export: foo a b/variant\n[cite:@a]" + (let ((org-cite-export-processors nil) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("b c" . "variant") + (catch :exit + (org-test-with-temp-text + "#+cite_export: foo a \"b c/variant\"\n[cite:@a]" + (let ((org-cite-export-processors nil) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + ;; Extract style from citation itself. + (should + (equal '("b") + (catch :exit + (org-test-with-temp-text "[cite/b:@a]" + (let ((org-cite-export-processors '((t . (foo nil nil)))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("b" . "variant") + (catch :exit + (org-test-with-temp-text "[cite/b/variant:@a]" + (let ((org-cite-export-processors '((t . (foo nil nil)))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + ;; Test priority: first object, then local. + (should + (equal '("object") + (catch :exit + (org-test-with-temp-text + "#+cite_export: foo nil local\n[cite/object:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("local") + (catch :exit + (org-test-with-temp-text + "#+cite_export: foo nil local\n[cite:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + ;; Force default style with "nil". + (should + (equal '(nil) + (catch :exit + (org-test-with-temp-text + "#+cite_export: foo nil nil\n[cite:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '(nil) + (catch :exit + (org-test-with-temp-text "[cite/nil:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + ;; Test variant inheritance. + (should + (equal '("local" . "v2") + (catch :exit + (org-test-with-temp-text "[cite/local/v2:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global/v1")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("global" . "v2") + (catch :exit + (org-test-with-temp-text "[cite//v2:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global/v1")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '(nil . "v2") + (catch :exit + (org-test-with-temp-text "[cite/nil/v2:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global/v1")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend))))))) + (should + (equal '("local" . nil) + (catch :exit + (org-test-with-temp-text "[cite/local:@a]" + (let ((org-cite-export-processors '((t . (foo nil "global/v1")))) + (org-cite--processors nil)) + (org-cite-register-processor 'foo + :export-citation (lambda (_ s _ _) (throw :exit s))) + (org-export-as (org-export-create-backend)))))))) + +(ert-deftest test-org-cite/list-citations () + "Test `org-cite-list-citations'." + (should + (equal '("a") + (org-test-with-parsed-data "Test [cite:@a]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("a" "b") + (org-test-with-parsed-data "Test [cite:@a] [cite:@b]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("a") + (org-test-with-parsed-data "Test[fn:1]\n[fn:1] [cite:@a]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("a" "b") + (org-test-with-parsed-data "First[cite:@a] Second[fn:1]\n[fn:1] [cite:@b]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("b" "a") + (org-test-with-parsed-data "First[fn:1] Second[cite:@a]\n[fn:1] [cite:@b]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("a" "b") + (org-test-with-parsed-data + "Text[fn:1][fn:2]\n[fn:1] [cite:@a]\n\n[fn:2] [cite:@b]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("b" "a") + (org-test-with-parsed-data + "Text[fn:1]\n[fn:1] [fn:2][cite:@a]\n\n[fn:2] [cite:@b]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("a" "b") + (org-test-with-parsed-data + "Text[fn:1]\n[fn:1] [cite:@a][fn:2]\n\n[fn:2] [cite:@b]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info))))) + (should + (equal '("a") + (org-test-with-parsed-data "Text[fn::[cite:@a]]" + (cl-mapcan (lambda (c) + (mapcar (lambda (ref) + (org-element-property :key ref)) + (org-element-contents c))) + (org-cite-list-citations info)))))) + +(ert-deftest test-org-cite/list-keys () + "Test `org-cite-list-keys'." + (should + (equal '("a") + (org-test-with-parsed-data "Test [cite:@a]" + (org-cite-list-keys info)))) + (should + (equal '("a" "b") + (org-test-with-parsed-data "Test [cite:@a] [cite:@b]" + (org-cite-list-keys info)))) + ;; Remove duplicates. + (should + (equal '("a") + (org-test-with-parsed-data "Test [cite:@a] [cite:@a]" + (org-cite-list-keys info)))) + ;; Keys are ordered by first appearance in the document. + (should + (equal '("a" "b") + (org-test-with-parsed-data "Test [cite:@a] [cite:@b] [cite:@a]" + (org-cite-list-keys info)))) + (should + (equal '("a" "b" "c") + (org-test-with-parsed-data + "Test [cite:@a][fn:1] [cite:@c] [cite:@a]\n[fn:1] [cite:@b]" + (org-cite-list-keys info))))) + +(ert-deftest test-org-cite/key-number () + "Test `org-cite-key-number'." + (should + (= 1 (org-test-with-parsed-data "[cite:@key]" + (org-cite-key-number "key" info)))) + (should + (equal '(1 2) + (org-test-with-parsed-data "[cite:@key] [cite:@key2] [cite:@key]" + (list (org-cite-key-number "key" info) + (org-cite-key-number "key2" info))))) + ;; When "predicate" is nil, keys are sorted by appearance order in + ;; the buffer. + (should + (equal '((1 . "a") (2 . "c") (3 . "b")) + (org-test-with-parsed-data + "[cite:@a][fn:1] [cite:@b]\n[fn:1] [cite:@c]" + (sort (mapcar (lambda (key) + (cons (org-cite-key-number key info) key)) + '("a" "b" "c")) + #'car-less-than-car)))) + (should + (equal '((1 . "a") (2 . "b") (3 . "c")) + (org-test-with-parsed-data + "[cite:@a][fn:1] [cite:@b]\n[fn:1] [cite:@c]" + (sort (mapcar (lambda (key) + (cons (org-cite-key-number key info #'string<) key)) + '("a" "b" "c")) + #'car-less-than-car))))) + +(ert-deftest test-org-cite/wrap-citation () + "Test `org-cite-wrap-citation'." + ;; Reference test. + (should + (org-test-with-parsed-data "[cite:@key]" + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (org-cite-inside-footnote-p c)) + info))) + ;; Created footnote is anonymous. + (should-not + (org-test-with-parsed-data "[cite:@key] " + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (org-element-property :label (org-cite-inside-footnote-p c))) + info))) + ;; Created footnote is inline. + (should + (equal '(inline) + (org-test-with-parsed-data "[cite:@key]" + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (org-element-property :type + (org-cite-inside-footnote-p c))) + info)))) + ;; Preserve `:post-blank' property. + (should + (equal '(2) + (org-test-with-parsed-data "[cite:@key] " + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (org-element-property :post-blank + (org-cite-inside-footnote-p c))) + info)))) + ;; Set `:post-blank' to 0 in the element before new footnote. + (should-not + (org-test-with-parsed-data "Text [cite:@key]" + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (let ((previous + (org-export-get-previous-element + (org-cite-inside-footnote-p c) info))) + (string-match (rx blank string-end) previous))) + info))) + (should + (equal '(0) + (org-test-with-parsed-data "*Text* [cite:@key]" + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (let ((previous + (org-export-get-previous-element + (org-cite-inside-footnote-p c) info))) + (org-element-property :post-blank previous))) + info)))) + (should + (equal '("Text") + (org-test-with-parsed-data "Text [cite:@key]" + (org-element-map tree 'citation + (lambda (c) + (org-cite-wrap-citation c info) + (org-export-get-previous-element + (org-cite-inside-footnote-p c) info)) + info))))) + +(defun test-org-cite--export-with-rule (text &optional rule punct) + "Export TEXT string using RULE for punctuation positioning. +Call `org-cite-adjust-note' on each citation object with RULE and, PUNCT +arguments. Replace citation with \"@\" character in the output." + (org-test-with-temp-text text + (let ((org-cite--processors nil)) + (org-cite-register-processor 'test + :export-citation + (lambda (citation _s _b info) + (org-cite-adjust-note citation info rule punct) + "@")) + (let ((org-cite-export-processors '((t . (test nil nil))))) + (org-trim + (org-export-as + (org-export-create-backend + :transcoders + '((section . (lambda (_s c _i) (replace-regexp-in-string " @" "@" c))) + (paragraph . (lambda (_s c _i) c)))))))))) + +(ert-deftest test-org-cite/adjust-note () + "Test `org-cite-adjust-note' function." + ;; Basic tests for all rules. In the output, @ replaces citation. + (let ((cases '("\"[cite:@k]!" + ".\"[cite:@k]!" + "\"[cite:@k]" + ".\"[cite:@k]" + ".[cite:@k]" + "[cite:@k]!"))) + (should ;test (inside inside after) + (equal + '(iia "!@\"" ".@\"!" "@\"" ".@\"" ".@" "!@") + (cons 'iia + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(inside inside after))) + cases)))) + (should ;test (inside inside before) + (equal + '(iib "@!\"" "@.\"!" "@\"" "@.\"" "@." "@!") + (cons 'iib + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(inside inside before))) + cases)))) + (should ;test (inside outside after) + (equal + '(ioa "!\"@" ".\"!@" "\"@" ".\"@" ".@" "!@") + (cons 'ioa + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(inside outside after))) + cases)))) + (should ;test (inside outside before) + (equal + '(iob "!\"@" ".\"@!" "\"@" ".\"@" "@." "@!") + (cons 'iob + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(inside outside before))) + cases)))) + (should ;test (inside same after) + (equal + '(isa "!@\"" ".\"!@" "\"@" ".@\"" ".@" "!@") + (cons 'isa + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(inside same after))) + cases)))) + (should ;test (inside same before) + (equal + '(isb "@!\"" ".\"@!" "\"@" "@.\"" "@." "@!") + (cons 'isb + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(inside same before))) + cases)))) + (should ;test (outside inside after) + (equal + '(oia "@\"!" ".@\"!" "@\"" "@\"." ".@" "!@") + (cons 'oia + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(outside inside after))) + cases)))) + (should ;test (outside inside before) + (equal + '(oib "@\"!" "@.\"!" "@\"" "@\"." "@." "@!") + (cons 'oib + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(outside inside before))) + cases)))) + (should ;test (outside outside after) + (equal + '(ooa "\"!@" ".\"!@" "\"@" "\".@" ".@" "!@") + (cons 'ooa + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(outside outside after))) + cases)))) + (should ;test (outside outside before) + (equal + '(oob "\"@!" ".\"@!" "\"@" "\"@." "@." "@!") + (cons 'oob + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(outside outside before))) + cases)))) + (should ;test (outside same after) + (equal + '(osa "\"!@" ".\"!@" "\"@" "\".@" ".@" "!@") + (cons 'osa + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(outside same after))) + cases)))) + (should ;test (outside same before) + (equal + '(osb "\"@!" ".\"@!" "\"@" "\"@." "@." "@!") + (cons 'osb + (mapcar (lambda (c) + (test-org-cite--export-with-rule + c '(outside same before))) + cases))))) + ;; Test `adaptive' behaviour. + (should + (equal "@\"." + (test-org-cite--export-with-rule ".\" [cite:@k]" + '(adaptive inside after)))) + (should + (equal "@\"!" + (test-org-cite--export-with-rule "\" [cite:@k]!" + '(adaptive inside after)))) + (should + (equal ".@\"" + (test-org-cite--export-with-rule ".\"[cite:@k]" + '(adaptive inside after)))) + (should + (equal "!@\"" + (test-org-cite--export-with-rule "\"[cite:@k]!" + '(adaptive inside after)))) + ;; Handle white space when inserting citation before quotation mark + ;; or punctuation. + (should + (equal ",@\" next" + (test-org-cite--export-with-rule ",\" [cite:@k] next" + '(inside inside after)))) + (should + (equal "@,\" next" + (test-org-cite--export-with-rule ",\" [cite:@k] next" + '(inside inside before)))) + (should + (equal "@\"." + (test-org-cite--export-with-rule "\" [cite:@k]." + '(outside inside before)))) + (should + (equal "@\" !" + (test-org-cite--export-with-rule "\" [cite:@k] !" + '(outside inside before)))) + (should + (equal "text@ !" + (test-org-cite--export-with-rule "text ![cite:@k]" + '(inside outside before)))) + ;; Preserve white space between citation and final punctuation when + ;; moving citation past final punctuation. + (should + (equal "text !@" + (test-org-cite--export-with-rule "text [cite:@k] !" + '(inside inside after)))) + (should + (equal "text\n !@" + (test-org-cite--export-with-rule "text [cite:@k]\n !" + '(inside inside after)))) + ;; Choose punctuation with optional argument. + (should-not + (equal "!@" + (test-org-cite--export-with-rule "[cite:@k]!" + '(inside outside after) + '(".")))) + (should + (equal ".@" + (test-org-cite--export-with-rule "[cite:@k]." + '(inside outside after) + '("."))))) + +(ert-deftest test-org-cite/parse-elements () + "Test `org-cite-parse-elements' function." + (should-error (org-cite-parse-elements "* H")) + (should-error (org-cite-parse-elements "Paragraph\n* H")) + (should + (equal '(paragraph) + (mapcar #'org-element-type (org-cite-parse-elements "s")))) + (should + (equal '(paragraph paragraph) + (mapcar #'org-element-type (org-cite-parse-elements "Text\n\nText"))))) + +(ert-deftest test-org-cite/parse-objects () + "Test `org-cite-parse-objects' function." + (should + (equal '(plain-text) + (mapcar #'org-element-type (org-cite-parse-objects "s")))) + (should + (equal '(plain-text bold) + (mapcar #'org-element-type (org-cite-parse-objects "s *b*")))) + (should + (equal '(link) + (mapcar #'org-element-type (org-cite-parse-objects "[[link]]")))) + ;; When optional argument is non-nil, only recognize types allowed + ;; in as a citation reference affix. + (should-not + (equal '(link) + (mapcar #'org-element-type (org-cite-parse-objects "[[link]]" t)))) + (should + (equal '(bold) + (mapcar #'org-element-type (org-cite-parse-objects "*b*" t))))) + +(ert-deftest test-org-cite/make-paragraph () + "Test `org-cite-make-paragraph' function." + ;; Check string as argument. + (should + (eq 'paragraph + (org-element-type (org-cite-make-paragraph "a")))) + (should + (equal '("a") + (org-element-contents (org-cite-make-paragraph "a")))) + ;; Check object as argument. + (should + (eq 'paragraph + (org-element-type + (org-cite-make-paragraph (org-element-create 'bold nil "b"))))) + (should + (equal '(bold) + (mapcar #'org-element-type + (org-element-contents + (org-cite-make-paragraph (org-element-create 'bold nil "b")))))) + ;; Check secondary string as argument. + (should + (eq 'paragraph + (org-element-type (org-cite-make-paragraph '("a"))))) + (should + (equal '("a") + (org-element-contents (org-cite-make-paragraph '("a"))))) + ;; Mix all types of arguments. + (should + (equal '(plain-text bold plain-text) + (mapcar #'org-element-type + (org-element-contents + (org-cite-make-paragraph + "a" (org-element-create 'bold nil "b") '("c")))))) + ;; Check `:parent' property. + (should + (eq 'paragraph + (org-element-type + (org-element-property + :parent + (car (org-element-contents (org-cite-make-paragraph "a")))))))) + +(ert-deftest test-org-cite/emphasize () + "Test `org-cite-emphasize' function." + ;; Raise an error if first argument has wrong type. + (should-error (org-cite-emphasize 'code "a")) + ;; Check string argument. + (should (eq 'bold (org-element-type (org-cite-emphasize 'bold "a")))) + (should (equal '("a") (org-element-contents (org-cite-emphasize 'bold "a")))) + ;; Check object argument. + (should + (eq 'bold + (org-element-type + (org-cite-emphasize 'bold (org-element-create 'bold nil "a"))))) + (should + (equal '(italic) + (mapcar #'org-element-type + (org-element-contents + (org-cite-emphasize 'bold + (org-element-create 'italic nil "a")))))) + ;; Check secondary string argument. + (should (eq 'bold (org-element-type (org-cite-emphasize 'bold '("a"))))) + (should (equal '("a") (org-element-contents (org-cite-emphasize 'bold '("a"))))) + ;; Mix all types of arguments. + (should + (equal '(plain-text italic plain-text) + (mapcar #'org-element-type + (org-element-contents + (org-cite-emphasize 'bold + "a" (org-element-create 'italic nil "b") '("c")))))) + ;; Check `:parent' property. + (should + (eq 'bold + (org-element-type + (org-element-property + :parent + (car (org-element-contents (org-cite-emphasize 'bold "a")))))))) + +(ert-deftest test-org-cite/concat () + "Test `org-cite-concat' function." + ;; Return nil when there is no data. + (should + (equal "" (org-element-interpret-data (org-cite-concat)))) + ;; Concatenate strings, objects and secondary strings. + (should + (equal "ab" + (org-element-interpret-data (org-cite-concat "a" "b")))) + (should + (equal "*a* b" + (org-element-interpret-data + (org-cite-concat (org-element-create 'bold nil "a") " b")))) + (should + (equal "*a* b" + (org-element-interpret-data + (org-cite-concat + (list (org-element-create 'bold nil "a")) " b")))) + ;; Return an error for any other object type. + (should-error (org-cite-concat 2))) + +(ert-deftest test-org-cite/mapconcat () + "Test `org-cite-mapconcat' function." + (should + (equal "" + (org-element-interpret-data + (org-cite-mapconcat #'identity nil "")))) + (should + (equal "ab" + (org-element-interpret-data + (org-cite-mapconcat #'identity '("a" "b") "")))) + (should + (equal "*a* b *c*" + (org-element-interpret-data + (org-cite-mapconcat + #'identity + (list (org-element-create 'bold nil "a") + (list " b " (org-element-create 'bold nil "c"))) "")))) + (should + (equal "*a* *b*" + (org-element-interpret-data + (org-cite-mapconcat + (lambda (s) (org-element-create 'bold nil s)) + '("a" "b") " ")))) + (should + (equal "*a* b*c*" + (org-element-interpret-data + (org-cite-mapconcat + #'identity + (list (org-element-create 'bold nil "a") + (list "b" (org-element-create 'bold nil "c"))) " "))))) + + +;;; TEST capabilities. +(ert-deftest test-org-cite/activate-capability () + "Test \"activate\" capability." + ;; Standard test. + (should + (eq 'success + (catch :exit + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-activate-processor 'foo)) + (org-cite-register-processor 'foo + :activate (lambda (_) (throw :exit 'success))) + (font-lock-ensure)))))) + ;; If there is no "follow" processor, or if processor does not + ;; handle this capability, fall back to fontifying whole citation + ;; with `org-cite' face and each key with `org-cite-key' face. + (should + (eq 'org-cite + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite-activate-processor nil)) + (font-lock-ensure) + (face-at-point))))) + (should + (eq 'org-cite-key + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite-activate-processor nil)) + (font-lock-ensure) + (face-at-point))))) + (should + (eq 'org-cite + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-activate-processor 'foo)) + (org-cite-register-processor 'foo) + (font-lock-ensure) + (face-at-point)))))) + +(ert-deftest test-org-cite/export-capability () + "Test \"export\" capability." + ;; Regular citations export. + (should + (eq 'success + (catch :exit + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) (throw :exit 'success))) + (org-export-as (org-export-create-backend))))))) + ;; Export citation as string. + (should + (equal "citation\n" + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) "citation")) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c))))))))) + ;; Export citation as parsed object. + (should + (equal "success\n" + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) + (org-element-create 'bold nil "cite"))) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c)) + (bold . (lambda (&rest _) "success"))))))))) + ;; Export citation as a secondary string. + (should + (equal "boldtwo\n" + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) + (list (org-element-create 'bold nil "one") + "two"))) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c)) + (bold . (lambda (&rest _) "bold"))))))))) + ;; When exporting citation as a secondary string, last object + ;; inherits post-blank from initial citation. + (should + (equal "twobold one-space\n" + (org-test-with-temp-text "[cite:@key] one-space" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) + (list "two" + (org-element-create 'bold nil "one")))) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c)) + (bold . (lambda (&rest _) "bold"))))))))) + (should + (equal "boldtwo one-space\n" + (org-test-with-temp-text "[cite:@key] one-space" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) + (list (org-element-create 'bold nil "one") + "two"))) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c)) + (bold . (lambda (&rest _) "bold"))))))))) + ;; Regular bibliography export. + (should + (eq 'success + (catch :exit + (org-test-with-temp-text "#+print_bibliography:" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-bibliography (lambda (&rest _) (throw :exit 'success)) + :export-citation #'ignore) + (org-export-as (org-export-create-backend))))))) + (should + (equal "" + (org-test-with-temp-text "#+print_bibliography:" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation #'ignore) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c))))))))) + ;; Export bibliography as string. + (should + (equal "bibliography\n" + (org-test-with-temp-text "#+print_bibliography:" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-bibliography (lambda (&rest _) "bibliography") + :export-citation #'ignore) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c))))))))) + ;; Export bibliography as a parsed element. + (should + (equal "success\n" + (org-test-with-temp-text "#+print_bibliography:" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-bibliography + (lambda (&rest _) + (org-element-create 'example-block '(:value "foo"))) + :export-citation #'ignore) + (org-export-as + (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (example-block . (lambda (&rest _) "success"))))))))) + ;; Export bibliography as a list of parsed elements. + (should + (equal "success\nsuccess\n" + (org-test-with-temp-text "#+print_bibliography:" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-bibliography + (lambda (&rest _) + (list (org-element-create 'example-block '(:value "foo")) + (org-element-create 'example-block '(:value "bar")))) + :export-citation #'ignore) + (org-export-as + (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (example-block . (lambda (&rest _) "success"))))))))) + ;; When exporting bibliography as a list of parsed elements, the + ;; last element inherits post-blank from initial keyword. + (should + (equal "success\nsuccess\n\nText\n" + (org-test-with-temp-text "#+print_bibliography:\n\nText" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-bibliography + (lambda (&rest _) + (list (org-element-create 'example-block '(:value "foo")) + (org-element-create 'example-block '(:value "bar")))) + :export-citation #'ignore) + (org-export-as + (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (example-block . (lambda (&rest _) "success")) + (paragraph . (lambda (_ c _) c))))))))) + ;; Use more appropriate citation processor. + (should + (equal + '(p1 p1 p1 p3) + (org-test-with-temp-text "[cite:@a]" + (let ((org-export-registered-backends nil) + (org-cite--procesors nil) + (org-cite-export-processors + '((b1 . (p1)) + (t . (p3))))) + (org-cite-register-processor 'p1 + :export-citation (lambda (&rest _) (throw :exit 'p1))) + (org-cite-register-processor 'p2 + :export-citation (lambda (&rest _) (throw :exit 'p2))) + (org-cite-register-processor 'p3 + :export-citation (lambda (&rest _) (throw :exit 'p3))) + (org-export-define-backend 'b1 nil) + (org-export-define-derived-backend 'b2 'b1) + (org-export-define-derived-backend 'b3 'b2) + (list (catch :exit (org-export-as 'b1)) + (catch :exit (org-export-as 'b2)) + (catch :exit (org-export-as 'b3)) + (catch :exit (org-export-as (org-export-create-backend)))))))) + (should + (eq 'p2 + (org-test-with-temp-text "#+cite_export: p2\n[cite:@a]" + (let ((org-export-registered-backends nil) + (org-cite--procesors nil) + (org-cite-export-processors '((t . (p1))))) + (org-cite-register-processor 'p1 + :export-citation (lambda (&rest _) (throw :exit 'p1))) + (org-cite-register-processor 'p2 + :export-citation (lambda (&rest _) (throw :exit 'p2))) + (catch :exit (org-export-as (org-export-create-backend))))))) + ;; Test finalizer. + (should + (eq 'success + (catch :exit + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation (lambda (&rest _) "") + :export-finalizer (lambda (&rest _) (throw :exit 'success))) + (org-export-as (org-export-create-backend))))))) + (should + (equal "finalized!" + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo + :export-citation #'ignore + :export-finalizer (lambda (&rest _) "finalized!")) + (org-export-as (org-export-create-backend)))))) + ;; Ignore citations when there is no selected "export" processor. + ;; In that case, white space is removed before the citation, not + ;; after. + (should + (equal "" + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite-export-processors nil)) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c))))))))) + (should + (equal "Text.\n" + (org-test-with-temp-text "Text [cite:@key]." + (let ((org-cite-export-processors nil)) + (org-export-as (org-export-create-backend + :transcoders + '((section . (lambda (_ c _) c)) + (paragraph . (lambda (_ c _) c))))))))) + ;; Throw an error if selected processor does not handle "export" + ;; capability. + (should-error + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-export-processors '((t . (foo nil nil))))) + (org-cite-register-processor 'foo) + (org-export-as (org-export-create-backend)))))) + +(ert-deftest test-org-cite/follow-capability () + "Test \"follow\" capability." + ;; Standard test. + (should + (eq 'success + (catch :exit + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-follow-processor 'foo)) + (org-cite-register-processor 'foo + :follow (lambda (_ _) (throw :exit 'success))) + (org-open-at-point)))))) + ;; Throw an error if there is no "follow" processor, or if it is + ;; unable to follow a citation. + (should-error + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite-follow-processor nil)) + (org-open-at-point)))) + (should-error + (org-test-with-temp-text "[cite:@key]" + (let ((org-cite--processors nil) + (org-cite-follow-processor 'foo)) + (org-cite-register-processor 'foo) + (org-open-at-point))))) + +(ert-deftest test-org-cite/make-insert-processor () + "Test `org-cite-make-insert-processor'." + (should-error (org-cite-make-insert-processor 1 2)) + (should-error + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + #'ignore (lambda (&rest _) "s"))) + (org-cite-insert nil)))) + (should + (equal "[cite:@k]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@k;@a]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@k;pre @a]" + (org-test-with-temp-text "[cite:pre @a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:pre;@k;@a]" + (org-test-with-temp-text "[cite:pre;@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@a;@k]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@a post;@k]" + (org-test-with-temp-text "[cite:@a post]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@a;@k;post]" + (org-test-with-temp-text "[cite:@a;post]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert t) + (buffer-string))))) + (should + (equal "[cite/s:@a]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@a]" + (org-test-with-temp-text "[cite/style:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") (lambda (&rest _) ""))) + (org-cite-insert nil) + (buffer-string))))) + (should-error + (org-test-with-temp-text "[cite/style:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) "k") #'ignore)) + (org-cite-insert nil)))) + (should + (equal "[cite:@a][cite:@k]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) '("k")) (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite:@k][cite:@a]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) '("k")) (lambda (&rest _) "s"))) + (org-cite-insert nil) + (buffer-string))))) + (should + (equal "[cite/s:@k][cite:@a]" + (org-test-with-temp-text "[cite:@a]" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (org-cite-make-insert-processor + (lambda (&rest _) '("k")) (lambda (&rest _) "s"))) + (org-cite-insert t) + (buffer-string)))))) + +(ert-deftest test-org-cite/insert-capability () + "Test \"insert\" capability." + ;; Standard test. + (should + (eq 'success + (catch :exit + (org-test-with-temp-text "" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (lambda (_ _) (throw :exit 'success))) + (call-interactively #'org-cite-insert)))))) + ;; Throw an error if there is no "insert" processor, or if it is + ;; unable to insert a citation. + (should-error + (org-test-with-temp-text "" + (let ((org-cite-insert-processor nil)) + (call-interactively #'org-cite-insert)))) + (should-error + (org-test-with-temp-text "" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo) + (call-interactively #'org-cite-insert)))) + ;; Throw an error if the location is inappropriate for a citation. + (should-error + (org-test-with-temp-text "=verbatim text=" + (let ((org-cite--processors nil) + (org-cite-insert-processor 'foo)) + (org-cite-register-processor 'foo + :insert (lambda (_ _) (throw :exit 'success))) + (call-interactively #'org-cite-insert))))) + +(provide 'test-oc) +;;; test-oc.el ends here