oc.el (73548B)
1 ;;; oc.el --- Org Cite library -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2021-2023 Free Software Foundation, Inc. 4 5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr> 6 7 ;; This file is part of GNU Emacs. 8 9 ;; GNU Emacs is free software: you can redistribute it and/or modify 10 ;; it under the terms of the GNU General Public License as published by 11 ;; the Free Software Foundation, either version 3 of the License, or 12 ;; (at your option) any later version. 13 14 ;; GNU Emacs is distributed in the hope that it will be useful, 15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; GNU General Public License for more details. 18 19 ;; You should have received a copy of the GNU General Public License 20 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 21 22 ;;; Commentary: 23 24 ;; This library provides tooling to handle citations in Org, e.g, 25 ;; activate, follow, insert, and export them, respectively called 26 ;; "activate", "follow", "insert" and "export" capabilities. 27 ;; Libraries responsible for providing some, or all, of these 28 ;; capabilities are called "citation processors". 29 30 ;; Such processors are defined using `org-cite-register-processor'. 31 ;; Using this function, it is possible, in addition to giving it a 32 ;; name, to attach functions associated to capabilities. As such, a 33 ;; processor handling citation export must set the `:export-citation' 34 ;; property to an appropriate function. Likewise, "activate" 35 ;; capability requires an appropriate `:activate' property, "insert" 36 ;; requires `:insert' property and, unsurprisingly, "follow" 37 ;; capability implies `:follow' property. 38 39 ;; As a user, the first thing to do is setting a bibliography, either 40 ;; globally with `org-cite-global-bibliography', or locally using one 41 ;; or more "bibliography" keywords. Then one can select any 42 ;; registered processor for each capability by providing a processor 43 ;; name to the variables `org-cite-activate-processor' and 44 ;; `org-cite-follow-processor'. 45 46 ;; The "export" capability is slightly more involved as one need to 47 ;; select the processor providing it, but may also provide a default 48 ;; style for citations and bibliography. Also, the choice of an 49 ;; export processor may depend of the current export back-end. The 50 ;; association between export back-ends and triplets of parameters can 51 ;; be set in `org-cite-export-processors' variable, or in a document, 52 ;; through the "cite_export" keyword. 53 54 ;; Eventually, this library provides some tools, mainly targeted at 55 ;; processor implementors. Most are export-specific and are located 56 ;; in the "Tools only available during export" and "Tools generating 57 ;; or operating on parsed data" sections. 58 59 ;; The few others can be used directly from an Org buffer, or operate 60 ;; on processors. See "Generic tools" section. 61 62 ;;; Code: 63 64 (require 'org-macs) 65 (org-assert-version) 66 67 (require 'org-compat) 68 (require 'org-macs) 69 (require 'seq) 70 71 (declare-function org-at-heading-p "org" (&optional _)) 72 (declare-function org-collect-keywords "org" (keywords &optional unique directory)) 73 74 (declare-function org-element-adopt-elements "org-element" (parent &rest children)) 75 (declare-function org-element-citation-parser "org-element" ()) 76 (declare-function org-element-citation-reference-parser "org-element" ()) 77 (declare-function org-element-class "org-element" (datum &optional parent)) 78 (declare-function org-element-contents "org-element" (element)) 79 (declare-function org-element-create "org-element" (type &optional props &rest children)) 80 (declare-function org-element-extract-element "org-element" (element)) 81 (declare-function org-element-insert-before "org-element" (element location)) 82 (declare-function org-element-lineage "org-element" (datum &optional types with-self)) 83 (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) 84 (declare-function org-element-normalize-string "org-element" (s)) 85 (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) 86 (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) 87 (declare-function org-element-context "org-element" (&optional element)) 88 (declare-function org-element-property "org-element" (property element)) 89 (declare-function org-element-put-property "org-element" (element property value)) 90 (declare-function org-element-restriction "org-element" (element)) 91 (declare-function org-element-set-element "org-element" (old new)) 92 (declare-function org-element-type "org-element" (element)) 93 94 (declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) 95 (declare-function org-export-get-next-element "org-export" (blob info &optional n)) 96 (declare-function org-export-get-previous-element "org-export" (blob info &optional n)) 97 (declare-function org-export-raw-string "org-export" (s)) 98 99 (defvar org-complex-heading-regexp) 100 (defvar org-element-all-objects) 101 (defvar org-element-citation-key-re) 102 (defvar org-element-citation-prefix-re) 103 (defvar org-element-parsed-keywords) 104 105 106 ;;; Constants 107 ;; Borrowed from "citeproc.el" library. 108 (defconst org-cite--default-region-alist 109 '(("af" . "za") ("ca" . "ad") ("cs" . "cz") ("cy" . "gb") 110 ("da" . "dk") ("el" . "gr") ("et" . "ee") ("fa" . "ir") 111 ("he" . "ir") ("ja" . "jp") ("km" . "kh") ("ko" . "kr") 112 ("nb" . "no") ("nn" . "no") ("sl" . "si") ("sr" . "rs") 113 ("sv" . "se") ("uk" . "ua") ("vi" . "vn") ("zh" . "cn")) 114 "Alist mapping those languages to their default region. 115 Only those languages are given for which the default region is not simply the 116 result of duplicating the language part.") 117 118 119 ;;; Configuration variables 120 (defgroup org-cite nil 121 "Options concerning citations in Org mode." 122 :group 'org 123 :tag "Org Cite") 124 125 (defcustom org-cite-global-bibliography nil 126 "List of bibliography files available in all documents. 127 File names must be absolute." 128 :group 'org-cite 129 :package-version '(Org . "9.5") 130 :type '(choice (const :tag "No global bibliography" nil) 131 (repeat :tag "List of bibliography files" 132 (file :tag "Bibliography")))) 133 134 (defcustom org-cite-activate-processor 'basic 135 "Processor used for activating citations, as a symbol." 136 :group 'org-cite 137 :package-version '(Org . "9.5") 138 :type '(choice (const :tag "Default fontification" nil) 139 (symbol :tag "Citation processor"))) 140 141 (defcustom org-cite-export-processors '((t basic)) 142 "Processor used for exporting citations, as a triplet, or nil. 143 144 When nil, citations and bibliography are not exported. 145 146 When non-nil, the value is an association list between export back-ends and 147 citation export processors: 148 149 (BACK-END . PROCESSOR) 150 151 where BACK-END is the name of an export back-end or t, and PROCESSOR is a 152 triplet following the pattern 153 154 (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) 155 156 There, NAME is the name of a registered citation processor providing export 157 functionality, as a symbol. BIBLIOGRAPHY-STYLE (respectively CITATION-STYLE) 158 is the desired default style to use when printing a bibliography (respectively 159 exporting a citation), as a string or nil. Both BIBLIOGRAPHY-STYLE and 160 CITATION-STYLE are optional. NAME is mandatory. 161 162 The export process selects the citation processor associated to the current 163 export back-end, or the most specific back-end the current one is derived from, 164 or, if all are inadequate, to the processor associated to t. For example, with 165 the following value 166 167 ((beamer natbib) 168 (latex biblatex) 169 (t csl)) 170 171 exporting with `beamer' or any back-end derived from it will use `natbib', 172 whereas exporting with `latex' or any back-end derived from it but different 173 from `beamer' will use `biblatex' processor. Any other back-end, such as 174 `html', will use `csl' processor. 175 176 CITATION-STYLE is overridden by adding a style to any citation object. A nil 177 style lets the export processor choose the default output. Any style not 178 recognized by the export processor is equivalent to nil. 179 180 The citation triplet can also be set with the CITE_EXPORT keyword. 181 E.g., 182 183 #+CITE_EXPORT: basic note numeric 184 185 or 186 187 #+CITE_EXPORT: basic 188 189 In that case, `basic' processor is used on every export, independently on the 190 back-end." 191 :group 'org-cite 192 :package-version '(Org . "9.5") 193 :type '(choice (const :tag "No export" nil) 194 (alist :key-type symbol 195 :value-type 196 (list :tag "Citation processor" 197 (symbol :tag "Processor name") 198 (choice 199 (const :tag "Default bibliography style" nil) 200 (string :tag "Use specific bibliography style")) 201 (choice 202 (const :tag "Default citation style" nil) 203 (string :tag "Use specific citation style")))))) 204 205 (defcustom org-cite-follow-processor 'basic 206 "Processor used for following citations, as a symbol." 207 :group 'org-cite 208 :package-version '(Org . "9.5") 209 :type '(choice (const :tag "No following" nil) 210 (symbol :tag "Citation processor"))) 211 212 (defcustom org-cite-insert-processor 'basic 213 "Processor used for inserting citations, as a symbol." 214 :group 'org-cite 215 :package-version '(Org . "9.5") 216 :type '(choice (const :tag "No insertion" nil) 217 (symbol :tag "Citation processor"))) 218 219 (defcustom org-cite-adjust-note-numbers t 220 "When non-nil, allow process to modify location of note numbers. 221 222 When this variable is non-nil, it is possible to swap between author-date and 223 note style without modifying the document. To that effect, citations should 224 always be located as in an author-date style. Prior to turning the citation 225 into a footnote, the citation processor moves the citation (i.e., the future 226 note number), and the surrounding punctuation, according to rules defined in 227 `org-cite-note-rules'. 228 229 When nil, the note number is not moved." 230 :group 'org-cite 231 :package-version '(Org . "9.5") 232 :type '(choice (const :tag "Automatic note number location" t) 233 (const :tag "Place note numbers manually" nil)) 234 :safe #'booleanp) 235 236 (defcustom org-cite-note-rules 237 '(("en-us" inside outside after) 238 ("fr" adaptive same before)) 239 "Alist between languages and typographic rules for citations in note style. 240 241 When `org-cite-adjust-note-numbers' is non-nil, and note style is requested, 242 citation processor is allowed to move the note marker according to some specific 243 rules, detailed here. More accurately, a rule is a list following the pattern 244 245 (LANGUAGE-TAG . RULE) 246 247 LANGUAGE-TAG is a down-cased string representing a language tag as defined in 248 RFC 4646. It may constituted of a language and a region separated with an 249 hyphen (e.g., \"en-us\"), or the language alone (e.g., \"fr\"). A language 250 without a region applies to all regions. 251 252 RULE is a triplet 253 254 (PUNCTUATION NUMBER ORDER) 255 256 PUNCTUATION is the desired location of the punctuation with regards to the 257 quotation, if any. It may be `inside', `outside', or `adaptive'. The latter 258 permits subtler control over the punctuation: when there is no space between 259 the quotation mark and the punctuation, it is equivalent to `inside'. 260 Otherwise, it means `outside', as illustrated in the following examples: 261 262 \"A quotation ending without punctuation\" [cite:@org21]. 263 \"A quotation ending with a period\"[cite:@org21]. 264 265 Notwithstanding the above, a space always appear before the citation when it 266 is to become anything else than a note. 267 268 NUMBER is the desired location of the note number with regards to the 269 quotation mark, if any. It may be `inside', `outside', or `same'. When set 270 to `same', the number appears on the same side as the punctuation, unless 271 there is punctuation on both sides or on none. 272 273 ORDER is the relative position of the citation with regards to the closest 274 punctuation. It may be `after' or `before'. 275 276 For example (adaptive same before) corresponds to French typography. 277 278 When the locale is unknown to this variable, the default rule is: 279 280 (adaptive outside after) 281 282 This roughly follows the Oxford Guide to Style recommendations." 283 :group 'org-cite 284 :package-version '(Org . "9.5") 285 :type 286 '(repeat 287 (list :tag "Typographic rule" 288 (string :tag "Language code") 289 (choice :tag "Location of punctuation" 290 (const :tag "Punctuation inside quotation" inside) 291 (const :tag "Punctuation outside quotation" outside) 292 (const :tag "Location depends on spacing" adaptive)) 293 (choice :tag "Location of citation" 294 (const :tag "Citation inside quotation" inside) 295 (const :tag "Citation outside quotation" outside) 296 (const :tag "Citation next to punctuation" same)) 297 (choice :tag "Order of citation and punctuation" 298 (const :tag "Citation first" before) 299 (const :tag "Citation last" after))))) 300 301 (defcustom org-cite-punctuation-marks '("." "," ";" ":" "!" "?") 302 "List of strings that can be moved around when placing note numbers. 303 304 When `org-cite-adjust-note-numbers' is non-nil, the citation processor is 305 allowed to shuffle punctuation marks specified in this list in order to 306 place note numbers according to rules defined in `org-cite-note-rules'." 307 :group 'org-cite 308 :package-version '(Org . "9.5") 309 :type '(repeat string)) 310 311 312 ;;; Citation processors 313 (cl-defstruct (org-cite-processor (:constructor org-cite--make-processor) 314 (:copier nil)) 315 (name nil :read-only t) 316 (activate nil :read-only t) 317 (cite-styles nil :read-only t) 318 (export-bibliography nil :read-only t) 319 (export-citation nil :read-only t) 320 (export-finalizer nil :read-only t) 321 (follow nil :read-only t) 322 (insert nil :read-only t)) 323 324 (defvar org-cite--processors nil 325 "List of registered citation processors. 326 See `org-cite-register-processor' for more information about 327 processors.") 328 329 (defun org-cite-register-processor (name &rest body) 330 "Mark citation processor NAME as available. 331 332 NAME is a symbol. BODY is a property list, where the following 333 optional keys can be set: 334 335 `:activate' 336 337 Function activating a citation. It is called with a single 338 argument: a citation object extracted from the current 339 buffer. It may add text properties to the buffer. If it is 340 not provided, `org-cite-fontify-default' is used. 341 342 `:export-bibliography' 343 344 Function rendering a bibliography. It is called with six 345 arguments: the list of citation keys used in the document, as 346 strings, a list of bibliography files, the style, as a string 347 or nil, the local properties, as a property list, the export 348 back-end, as a symbol, and the communication channel, as a 349 property list. 350 351 It is called at each \"print_bibliography\" keyword in the 352 parse tree. It may return a string, a parsed element, a list 353 of parsed elements, or nil. When it returns nil, the keyword 354 is ignored. Otherwise, the value it returns replaces the 355 keyword in the export output. 356 357 `:export-citation' (mandatory for \"export\" capability) 358 359 Function rendering citations. It is called with four 360 arguments: a citation object, the style, as a pair, the 361 export back-end, as a symbol, and the communication channel, 362 as a property list. 363 364 It is called on each citation object in the parse tree. It 365 may return a string, a parsed object, a secondary string, or 366 nil. When it returns nil, the citation is ignored. 367 Otherwise, the value it returns replaces the citation object 368 in the export output. 369 370 `:export-finalizer' 371 372 Function called at the end of export process. It must accept 373 six arguments: the output, as a string, a list of citation 374 keys used in the document, a list of bibliography files, the 375 expected bibliography style, as a string or nil, the export 376 back-end, as a symbol, and the communication channel, as a 377 property list. 378 379 It must return a string, which will become the final output 380 from the export process, barring subsequent modifications 381 from export filters. 382 383 `:follow' 384 385 Function called to follow a citation. It accepts two 386 arguments, the citation or citation reference object at 387 point, and any prefix argument received during interactive 388 call of `org-open-at-point'. 389 390 `:insert' 391 392 Function called to insert a citation. It accepts two 393 arguments, the citation or citation reference object at point 394 or nil, and any prefix argument received. 395 396 `:cite-styles' 397 398 When the processor has export capability, the value can 399 specify what cite styles, variants, and their associated 400 shortcuts are supported. It can be useful information for 401 completion or linting. 402 403 The expected format is 404 405 ((STYLE . SHORTCUTS) . VARIANTS)) 406 407 where STYLE is a string, SHORTCUTS a list of strings or nil, 408 and VARIANTS is a list of pairs (VARIANT . SHORTCUTS), 409 VARIANT being a string and SHORTCUTS a list of strings or 410 nil. 411 412 The \"nil\" style denotes the processor fall-back style. It 413 should have a corresponding entry in the value. 414 415 The value can also be a function. It will be called without 416 any argument and should return a list structured as the above. 417 418 Return a non-nil value on a successful operation." 419 (declare (indent 1)) 420 (unless (and name (symbolp name)) 421 (error "Invalid processor name: %S" name)) 422 (setq org-cite--processors 423 (cons (apply #'org-cite--make-processor :name name body) 424 (seq-remove (lambda (p) (eq name (org-cite-processor-name p))) 425 org-cite--processors)))) 426 427 (defun org-cite-try-load-processor (name) 428 "Try loading citation processor NAME if unavailable. 429 NAME is a symbol. When the NAME processor is unregistered, try 430 loading \"oc-NAME\" library beforehand, then cross fingers." 431 (unless (org-cite-get-processor name) 432 (require (intern (format "oc-%s" name)) nil t))) 433 434 (defun org-cite-get-processor (name) 435 "Return citation processor named after symbol NAME. 436 Return nil if no such processor is found." 437 (seq-find (lambda (p) (eq name (org-cite-processor-name p))) 438 org-cite--processors)) 439 440 (defun org-cite-unregister-processor (name) 441 "Unregister citation processor NAME. 442 NAME is a symbol. Raise an error if processor is not registered. 443 Return a non-nil value on a successful operation." 444 (unless (and name (symbolp name)) 445 (error "Invalid processor name: %S" name)) 446 (pcase (org-cite-get-processor name) 447 ('nil (error "Processor %S not registered" name)) 448 (processor 449 (setq org-cite--processors (delete processor org-cite--processors)))) 450 t) 451 452 (defun org-cite-processor-has-capability-p (processor capability) 453 "Return non-nil if PROCESSOR is able to handle CAPABILITY. 454 PROCESSOR is the name of a cite processor, as a symbol. CAPABILITY is 455 `activate', `export', `follow', or `insert'." 456 (let ((p (org-cite-get-processor processor))) 457 (pcase capability 458 ((guard (not p)) nil) ;undefined processor 459 ('activate (functionp (org-cite-processor-activate p))) 460 ('export (functionp (org-cite-processor-export-citation p))) 461 ('follow (functionp (org-cite-processor-follow p))) 462 ('insert (functionp (org-cite-processor-insert p))) 463 (other (error "Invalid capability: %S" other))))) 464 465 466 ;;; Internal functions 467 (defun org-cite--set-post-blank (datum blanks) 468 "Set `:post-blank' property from element or object before DATUM to BLANKS. 469 DATUM is an element or object. BLANKS is an integer. DATUM is modified 470 by side-effect." 471 (if (not (eq 'plain-text (org-element-type datum))) 472 (org-element-put-property datum :post-blank blanks) 473 ;; Remove any blank from string before DATUM so it is exported 474 ;; with exactly BLANKS white spaces. 475 (org-element-set-element 476 datum 477 (replace-regexp-in-string 478 "[ \t\n]*\\'" (make-string blanks ?\s) datum)))) 479 480 (defun org-cite--set-previous-post-blank (datum blanks info) 481 "Set `:post-blank' property from element or object before DATUM to BLANKS. 482 DATUM is an element or object. BLANKS is an integer. INFO is the export 483 state, as a property list. Previous element or object, if any, is modified by 484 side-effect." 485 (let ((previous (org-export-get-previous-element datum info))) 486 (when previous 487 (org-cite--set-post-blank previous blanks)))) 488 489 (defun org-cite--insert-at-split (s citation n regexp) 490 "Split string S and insert CITATION object between the two parts. 491 S is split at beginning of match group N upon matching REGEXP against it. 492 This function assumes S precedes CITATION." 493 ;; When extracting the citation, remove white spaces before it, but 494 ;; preserve those after it. 495 (let ((post-blank (org-element-property :post-blank citation))) 496 (when (and post-blank (> post-blank 0)) 497 (org-element-insert-before (make-string post-blank ?\s) citation))) 498 (org-element-insert-before 499 (org-element-put-property (org-element-extract-element citation) 500 :post-blank 0) 501 s) 502 (string-match regexp s) 503 (let* ((split (match-beginning n)) 504 (first-part (substring s nil split)) 505 ;; Remove trailing white spaces as they are before the 506 ;; citation. 507 (last-part 508 (replace-regexp-in-string (rx (1+ (any blank ?\n)) string-end) 509 "" 510 (substring s split)))) 511 (when (org-string-nw-p first-part) 512 (org-element-insert-before first-part citation)) 513 (org-element-set-element s last-part))) 514 515 (defun org-cite--move-punct-before (punct citation s info) 516 "Move punctuation PUNCT before CITATION object. 517 String S contains PUNCT. INFO is the export state, as a property list. 518 The function assumes S follows CITATION. Parse tree is modified by side-effect." 519 (if (equal s punct) 520 (org-element-extract-element s) ;it would be empty anyway 521 (org-element-set-element s (substring s (length punct)))) 522 ;; Remove blanks before citation. 523 (org-cite--set-previous-post-blank citation 0 info) 524 (org-element-insert-before 525 ;; Blanks between citation and punct are now before punct and 526 ;; citation. 527 (concat (make-string (or (org-element-property :post-blank citation) 0) ?\s) 528 punct) 529 citation)) 530 531 (defun org-cite--parse-as-plist (s) 532 "Parse string S as a property list. 533 Values are always strings. Return nil if S is nil." 534 (cond 535 ((null s) nil) 536 ((stringp s) 537 (with-temp-buffer 538 (save-excursion (insert s)) 539 (skip-chars-forward " \t") 540 (let ((results nil) 541 (value-flag nil)) 542 (while (not (eobp)) 543 (pcase (char-after) 544 (?: 545 (push (read (current-buffer)) results) 546 (setq value-flag t)) 547 ((guard (not value-flag)) 548 (skip-chars-forward "^ \t")) 549 (?\" 550 (let ((origin (point))) 551 (condition-case _ 552 (progn 553 (read (current-buffer)) 554 (push (buffer-substring (1+ origin) (1- (point))) results)) 555 (end-of-file 556 (goto-char origin) 557 (skip-chars-forward "^ \t") 558 (push (buffer-substring origin (point)) results))) 559 (setq value-flag nil))) 560 (_ 561 (let ((origin (point))) 562 (skip-chars-forward "^ \t") 563 (push (buffer-substring origin (point)) results) 564 (setq value-flag nil)))) 565 (skip-chars-forward " \t")) 566 (nreverse results)))) 567 (t (error "Invalid argument type: %S" s)))) 568 569 (defun org-cite--get-note-rule (info) 570 "Return punctuation rule according to language used for export. 571 572 INFO is the export state, as a property list. 573 574 Rule is found according to the language used for export and 575 `org-cite-note-rules', which see. 576 577 If there is no rule matching current language, the rule defaults 578 to (adaptive outside after)." 579 (let* ((language-tags 580 ;; Normalize language as a language-region tag, as described 581 ;; in RFC 4646. 582 (pcase (split-string (plist-get info :language) "[-_]") 583 (`(,language) 584 (list language 585 (or (cdr (assoc language org-cite--default-region-alist)) 586 language))) 587 (`(,language ,region) 588 (list language region)) 589 (other 590 (error "Invalid language identifier: %S" other)))) 591 (language-region (mapconcat #'downcase language-tags "-")) 592 (language (car language-tags))) 593 (or (cdr (assoc language-region org-cite-note-rules)) 594 (cdr (assoc language org-cite-note-rules)) 595 '(adaptive outside after)))) 596 597 598 ;;; Generic tools 599 (defun org-cite-list-bibliography-files () 600 "List all bibliography files defined in the buffer." 601 (delete-dups 602 (append (mapcar (lambda (value) 603 (pcase value 604 (`(,f . ,d) 605 (expand-file-name (org-strip-quotes f) d)))) 606 (pcase (org-collect-keywords 607 '("BIBLIOGRAPHY") nil '("BIBLIOGRAPHY")) 608 (`(("BIBLIOGRAPHY" . ,pairs)) pairs))) 609 org-cite-global-bibliography))) 610 611 (defun org-cite-get-references (citation &optional keys-only) 612 "Return citations references contained in CITATION object. 613 614 When optional argument KEYS-ONLY is non-nil, return the references' keys, as a 615 list of strings. 616 617 Assume CITATION object comes from either a full parse tree, e.g., during export, 618 or from the current buffer." 619 (let ((contents (org-element-contents citation))) 620 (cond 621 ((null contents) 622 (org-with-point-at (org-element-property :contents-begin citation) 623 (narrow-to-region (point) (org-element-property :contents-end citation)) 624 (let ((references nil)) 625 (while (not (eobp)) 626 (let ((reference (org-element-citation-reference-parser))) 627 (goto-char (org-element-property :end reference)) 628 (push (if keys-only 629 (org-element-property :key reference) 630 reference) 631 references))) 632 (nreverse references)))) 633 (keys-only (mapcar (lambda (r) (org-element-property :key r)) contents)) 634 (t contents)))) 635 636 (defun org-cite-boundaries (citation) 637 "Return the beginning and end strict position of CITATION. 638 Returns a (BEG . END) pair." 639 (let ((beg (org-element-property :begin citation)) 640 (end (org-with-point-at (org-element-property :end citation) 641 (skip-chars-backward " \t") 642 (point)))) 643 (cons beg end))) 644 645 (defun org-cite-key-boundaries (reference) 646 "Return citation REFERENCE's key boundaries as buffer positions. 647 The function returns a pair (START . END) where START and END denote positions 648 in the current buffer. Positions include leading \"@\" character." 649 (org-with-point-at (org-element-property :begin reference) 650 (let ((end (org-element-property :end reference))) 651 (re-search-forward org-element-citation-key-re end t) 652 (cons (match-beginning 0) (match-end 0))))) 653 654 (defun org-cite-main-affixes (citation) 655 "Return main affixes for CITATION object. 656 657 Some export back-ends only support a single pair of affixes per 658 citation, even if it contains multiple keys. This function 659 decides what affixes are the most appropriate. 660 661 Return a pair (PREFIX . SUFFIX) where PREFIX and SUFFIX are 662 parsed data." 663 (let ((source 664 ;; When there are multiple references, use global affixes. 665 ;; Otherwise, local affixes have priority. 666 (pcase (org-cite-get-references citation) 667 (`(,reference) reference) 668 (_ citation)))) 669 (cons (org-element-property :prefix source) 670 (org-element-property :suffix source)))) 671 672 (defun org-cite-supported-styles (&optional processors) 673 "List of supported citation styles and variants. 674 675 Supported styles are those handled by export processors from 676 `org-cite-export-processors', or in PROCESSORS, as a list of symbols, 677 when non-nil. 678 679 Return value is a list with the following items: 680 681 ((STYLE . SHORTCUTS) . VARIANTS)) 682 683 where STYLE is a string, SHORTCUTS a list of strings, and VARIANTS is a list of 684 pairs (VARIANT . SHORTCUTS), VARIANT being a string and SHORTCUTS a list of 685 strings." 686 (let ((collection 687 (seq-mapcat 688 (lambda (name) 689 (pcase (org-cite-processor-cite-styles 690 (org-cite-get-processor name)) 691 ((and (pred functionp) f) (funcall f)) 692 (static-data static-data))) 693 (or processors 694 (mapcar (pcase-lambda (`(,_ . (,name . ,_))) name) 695 org-cite-export-processors)))) 696 (result nil)) 697 ;; Merge duplicate styles. Each style full name is guaranteed to 698 ;; be unique, and associated to all shortcuts and all variants in 699 ;; the initial collection. 700 (pcase-dolist (`((,style . ,shortcuts) . ,variants) collection) 701 (let ((entry (assoc style result))) 702 (if (not entry) 703 (push (list style shortcuts variants) result) 704 (setf (nth 1 entry) 705 (seq-uniq (append shortcuts (nth 1 entry)))) 706 (setf (nth 2 entry) 707 (append variants (nth 2 entry)))))) 708 ;; Return value with the desired format. 709 (nreverse 710 (mapcar (pcase-lambda (`(,style ,shortcuts ,variants)) 711 (cons (cons style (nreverse shortcuts)) 712 ;; Merge variant shortcuts. 713 (let ((result nil)) 714 (pcase-dolist (`(,variant . ,shortcuts) variants) 715 (let ((entry (assoc variant result))) 716 (if (not entry) 717 (push (cons variant shortcuts) result) 718 (setf (cdr entry) 719 (seq-uniq (append shortcuts (cdr entry))))))) 720 result))) 721 result)))) 722 723 (defun org-cite-delete-citation (datum) 724 "Delete citation or citation reference DATUM. 725 When removing the last reference, also remove the whole citation." 726 (pcase (org-element-type datum) 727 ('citation 728 (pcase-let* ((`(,begin . ,end) (org-cite-boundaries datum)) 729 (pos-before-blank 730 (org-with-point-at begin 731 (skip-chars-backward " \t") 732 (point))) 733 (pos-after-blank (org-element-property :end datum)) 734 (first-on-line? 735 (= pos-before-blank (line-beginning-position))) 736 (last-on-line? 737 (= pos-after-blank (line-end-position)))) 738 (cond 739 ;; The citation is alone on its line. Remove the whole line. 740 ;; Do not leave it blank as it might break a surrounding 741 ;; paragraph. 742 ((and first-on-line? last-on-line?) 743 (delete-region (line-beginning-position) (line-beginning-position 2))) 744 ;; When the citation starts the line, preserve indentation. 745 (first-on-line? (delete-region begin pos-after-blank)) 746 ;; When the citation ends the line, remove any trailing space. 747 (last-on-line? (delete-region pos-before-blank (line-end-position))) 748 ;; Otherwise, delete blanks before the citation. 749 ;; Nevertheless, make sure there is at least one blank left, 750 ;; so as to not splice unrelated surroundings. 751 (t 752 (delete-region pos-before-blank end) 753 (when (= pos-after-blank end) 754 (org-with-point-at pos-before-blank (insert " "))))))) 755 ('citation-reference 756 (let* ((citation (org-element-property :parent datum)) 757 (references (org-cite-get-references citation)) 758 (begin (org-element-property :begin datum)) 759 (end (org-element-property :end datum))) 760 (cond 761 ;; Single reference. 762 ((= 1 (length references)) 763 (org-cite-delete-citation citation)) 764 ;; First reference, no prefix. 765 ((and (= begin (org-element-property :contents-begin citation)) 766 (not (org-element-property :prefix citation))) 767 (org-with-point-at (org-element-property :begin datum) 768 (skip-chars-backward " \t") 769 (delete-region (point) end))) 770 ;; Last reference, no suffix. 771 ((and (= end (org-element-property :contents-end citation)) 772 (not (org-element-property :suffix citation))) 773 (delete-region (1- begin) (1- (cdr (org-cite-boundaries citation))))) 774 ;; Somewhere in-between. 775 (t 776 (delete-region begin end))))) 777 (other 778 (error "Invalid object type: %S" other)))) 779 780 781 ;;; Tools only available during export 782 (defun org-cite-citation-style (citation info) 783 "Return citation style used for CITATION object. 784 785 Style is a pair (NAME . VARIANT) where NAME and VARIANT are strings or nil. 786 A nil NAME means the default style for the current processor should be used. 787 788 INFO is a plist used as a communication channel." 789 (let* ((separate 790 (lambda (s) 791 (cond 792 ((null s) (cons nil nil)) 793 ((not (string-match "/" s)) (cons s nil)) 794 (t (cons (substring s nil (match-beginning 0)) 795 (org-string-nw-p (substring s (match-end 0)))))))) 796 (local (funcall separate (org-element-property :style citation))) 797 (global 798 (funcall separate (pcase (plist-get info :cite-export) 799 (`(,_ ,_ ,style) style) 800 (_ nil))))) 801 (cond 802 ((org-string-nw-p (car local)) 803 (cons (org-not-nil (car local)) (cdr local))) 804 (t 805 (cons (org-not-nil (car global)) 806 (or (cdr local) (cdr global))))))) 807 808 (defun org-cite-read-processor-declaration (s) 809 "Read processor declaration from string S. 810 811 Return (NAME BIBLIOGRAPHY-STYLE CITATION-STYLE) triplet, when 812 NAME is the processor name, as a symbol, and both 813 BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings or nil. Those 814 strings may contain spaces if they are enclosed within double 815 quotes. 816 817 String S is expected to contain between 1 and 3 tokens. The 818 function raises an error when it contains too few or too many 819 tokens. Spurious spaces are ignored." 820 (with-temp-buffer 821 (save-excursion (insert s)) 822 (let ((result (list (read (current-buffer))))) 823 (dotimes (_ 2) 824 (skip-chars-forward " \t") 825 (cond 826 ((eobp) (push nil result)) 827 ((char-equal ?\" (char-after)) 828 (push (org-not-nil (read (current-buffer))) 829 result)) 830 (t 831 (let ((origin (point))) 832 (skip-chars-forward "^ \t") 833 (push (org-not-nil (buffer-substring origin (point))) 834 result))))) 835 (skip-chars-forward " \t") 836 (unless (eobp) 837 (error "Trailing garbage following cite export processor declaration %S" 838 s)) 839 (nreverse result)))) 840 841 (defun org-cite-bibliography-style (info) 842 "Return expected bibliography style. 843 INFO is a plist used as a communication channel." 844 (pcase (plist-get info :cite-export) 845 (`(,_ ,style ,_) style) 846 (_ nil))) 847 848 (defun org-cite-bibliography-properties (keyword) 849 "Return properties associated to \"print_bibliography\" KEYWORD object. 850 Return value is a property list." 851 (org-cite--parse-as-plist (org-element-property :value keyword))) 852 853 (defun org-cite-list-citations (info) 854 "List citations in the exported document. 855 Citations are ordered by appearance in the document, when following footnotes. 856 INFO is the export communication channel, as a property list." 857 (or (plist-get info :citations) 858 (letrec ((cites nil) 859 (tree (plist-get info :parse-tree)) 860 (definition-cache (make-hash-table :test #'equal)) 861 (definition-list nil) 862 (find-definition 863 ;; Find definition for standard reference LABEL. At 864 ;; this point, it is impossible to rely on 865 ;; `org-export-get-footnote-definition' because the 866 ;; function caches results that could contain 867 ;; un-processed citation objects. So we use 868 ;; a simplified version of the function above. 869 (lambda (label) 870 (or (gethash label definition-cache) 871 (org-element-map 872 (or definition-list 873 (setq definition-list 874 (org-element-map 875 tree 876 'footnote-definition 877 #'identity info))) 878 'footnote-definition 879 (lambda (d) 880 (and (equal label (org-element-property :label d)) 881 (puthash label 882 (or (org-element-contents d) "") 883 definition-cache))) 884 info t)))) 885 (search-cites 886 (lambda (data) 887 (org-element-map data '(citation footnote-reference) 888 (lambda (datum) 889 (pcase (org-element-type datum) 890 ('citation (push datum cites)) 891 ;; Do not force entering inline definitions, since 892 ;; `org-element-map' is going to enter it anyway. 893 ((guard (eq 'inline (org-element-property :type datum)))) 894 ;; Walk footnote definition. 895 (_ 896 (let ((label (org-element-property :label datum))) 897 (funcall search-cites 898 (funcall find-definition label))))) 899 nil) 900 info nil 'footnote-definition t)))) 901 (funcall search-cites tree) 902 (let ((result (nreverse cites))) 903 (plist-put info :citations result) 904 result)))) 905 906 (defun org-cite-list-keys (info) 907 "List citation keys in the exported document. 908 Keys are ordered by first appearance in the document, when following footnotes. 909 Duplicate keys are removed. INFO is the export communication channel, as a 910 property list." 911 (delete-dups 912 (org-element-map (org-cite-list-citations info) 'citation-reference 913 (lambda (r) (org-element-property :key r)) 914 info))) 915 916 (defun org-cite-key-number (key info &optional predicate) 917 "Return number associated to string KEY. 918 919 INFO is the export communication channel, as a property list. 920 921 Optional argument PREDICATE is called with two keys, and returns non-nil 922 if the first reference should sort before the second. When nil, references 923 are sorted in order cited." 924 (let* ((keys (org-cite-list-keys info)) 925 (sorted-keys (if (functionp predicate) 926 (sort keys predicate) 927 keys)) 928 (position (seq-position sorted-keys key #'string-equal))) 929 (and (integerp position) 930 (1+ position)))) 931 932 (defun org-cite-inside-footnote-p (citation &optional strict) 933 "Non-nil when CITATION object is contained within a footnote. 934 935 When optional argument STRICT is non-nil, return t only if CITATION represents 936 the sole contents of the footnote, e.g., after calling `org-cite-wrap-citation'. 937 938 When non-nil, the return value if the footnote container." 939 (let ((footnote 940 (org-element-lineage citation 941 '(footnote-definition footnote-reference)))) 942 (and footnote 943 (or (not strict) 944 (equal (org-element-contents (org-element-property :parent citation)) 945 (list citation))) 946 ;; Return value. 947 footnote))) 948 949 (defun org-cite-wrap-citation (citation info) 950 "Wrap an anonymous inline footnote around CITATION object in the parse tree. 951 952 INFO is the export state, as a property list. 953 954 White space before the citation, if any, are removed. The parse tree is 955 modified by side-effect. 956 957 Return newly created footnote object." 958 (let ((footnote 959 (list 'footnote-reference 960 (list :label nil 961 :type 'inline 962 :contents-begin (org-element-property :begin citation) 963 :contents-end (org-element-property :end citation) 964 :post-blank (org-element-property :post-blank citation))))) 965 ;; Remove any white space before citation. 966 (org-cite--set-previous-post-blank citation 0 info) 967 ;; Footnote swallows citation. 968 (org-element-insert-before footnote citation) 969 (org-element-adopt-elements footnote 970 (org-element-extract-element citation)))) 971 972 (defun org-cite-adjust-note (citation info &optional rule punct) 973 "Adjust note number location for CITATION object, and punctuation around it. 974 975 INFO is the export state, as a property list. 976 977 Optional argument RULE is the punctuation rule used, as a triplet. When nil, 978 rule is determined according to `org-cite-note-rules', which see. 979 980 Optional argument PUNCT is a list of punctuation marks to be considered. 981 When nil, it defaults to `org-cite-punctuation-marks'. 982 983 Parse tree is modified by side-effect. 984 985 Note: when calling both `org-cite-adjust-note' and `org-cite-wrap-citation' on 986 the same object, call `org-cite-adjust-note' first." 987 (when org-cite-adjust-note-numbers 988 (pcase-let* ((rule (or rule (org-cite--get-note-rule info))) 989 (punct-re (regexp-opt (or punct org-cite-punctuation-marks))) 990 ;; with Emacs <27.1. Argument of `regexp' form (PUNCT-RE this case) 991 ;; must be a string literal. 992 (previous-punct-re 993 (rx-to-string `(seq (opt (group (regexp ,(rx (0+ (any blank ?\n)))) 994 (regexp ,punct-re))) 995 (regexp ,(rx (opt (0+ (any blank ?\n)) (group ?\")) 996 (opt (group (1+ (any blank ?\n)))) 997 string-end))) 998 t)) 999 (next-punct-re 1000 (rx-to-string `(seq string-start 1001 (group (0+ (any blank ?\n)) (regexp ,punct-re))) 1002 t)) 1003 (next (org-export-get-next-element citation info)) 1004 (final-punct 1005 (and (stringp next) 1006 (string-match next-punct-re next) 1007 (match-string 1 next))) 1008 (previous 1009 ;; Find the closest terminal object. Consider 1010 ;; citation, subscript and superscript objects as 1011 ;; terminal. 1012 (org-last 1013 (org-element-map (org-export-get-previous-element citation info) 1014 '(citation code entity export-snippet footnote-reference 1015 line-break latex-fragment link plain-text 1016 radio-target statistics-cookie timestamp 1017 verbatim) 1018 #'identity info nil '(citation subscript superscript)))) 1019 (`(,punct ,quote ,spacing) 1020 (and (stringp previous) 1021 (string-match previous-punct-re previous) 1022 (list (match-string 1 previous) 1023 (match-string 2 previous) 1024 (match-string 3 previous))))) 1025 ;; Bail you when there is no quote and either no punctuation, or 1026 ;; punctuation on both sides. 1027 (when (or quote (org-xor punct final-punct)) 1028 ;; Phase 1: handle punctuation rule. 1029 (pcase rule 1030 ((guard (not quote)) nil) 1031 ;; Move punctuation inside. 1032 (`(,(or `inside (and `adaptive (guard (not spacing)))) . ,_) 1033 ;; This only makes sense if there is a quotation before the 1034 ;; citation that does not end with some punctuation. 1035 (when (and (not punct) final-punct) 1036 ;; Quote guarantees there is a string object before 1037 ;; citation. Likewise, any final punctuation guarantees 1038 ;; there is a string object following citation. 1039 (let ((new-prev 1040 (replace-regexp-in-string 1041 previous-punct-re 1042 (concat final-punct "\"") previous nil nil 2)) 1043 (new-next 1044 (replace-regexp-in-string 1045 ;; Before Emacs-27.1 `literal' `rx' form with a variable 1046 ;; as an argument is not available. 1047 (rx-to-string `(seq string-start ,final-punct) t) 1048 "" next))) 1049 (org-element-set-element previous new-prev) 1050 (org-element-set-element next new-next) 1051 (setq previous new-prev) 1052 (setq next new-next) 1053 (setq punct final-punct) 1054 (setq final-punct nil)))) 1055 ;; Move punctuation outside. 1056 (`(,(or `outside (and `adaptive (guard spacing))) . ,_) 1057 ;; This is only meaningful if there is some inner 1058 ;; punctuation and no final punctuation already. 1059 (when (and punct (not final-punct)) 1060 ;; Inner punctuation guarantees there is text object 1061 ;; before the citation. However, there is no information 1062 ;; about the object following citation, if any. 1063 ;; Therefore, we handle all the possible cases (string, 1064 ;; other type, or none). 1065 (let ((new-prev 1066 (replace-regexp-in-string 1067 previous-punct-re "" previous nil nil 1)) 1068 (new-next (if (stringp next) (concat punct next) punct))) 1069 (org-element-set-element previous new-prev) 1070 (cond 1071 ((stringp next) 1072 (org-element-set-element next new-next)) 1073 (next 1074 (org-element-insert-before new-next next)) 1075 (t 1076 (org-element-adopt-elements 1077 (org-element-property :parent citation) 1078 new-next))) 1079 (setq previous new-prev) 1080 (setq next new-next) 1081 (setq final-punct punct) 1082 (setq punct nil)))) 1083 (_ 1084 (error "Invalid punctuation rule: %S" rule)))) 1085 ;; Phase 2: move citation to its appropriate location. 1086 ;; 1087 ;; First transform relative citation location into a definitive 1088 ;; location, according to the surrounding punctuation. 1089 (pcase rule 1090 (`(,punctuation same ,order) 1091 (setf rule 1092 (list punctuation 1093 (cond 1094 ;; When there is punctuation on both sides, the 1095 ;; citation is necessarily on the outside. 1096 ((and punct final-punct) 'outside) 1097 (punct 'inside) 1098 (final-punct 'outside) 1099 ;; No punctuation: bail out on next step. 1100 (t nil)) 1101 order)))) 1102 (pcase rule 1103 (`(,_ nil ,_) nil) 1104 (`(,_ inside after) 1105 ;; Citation has to be moved after punct, if there is 1106 ;; a quotation mark, or after final punctuation. 1107 (cond 1108 (quote 1109 (org-cite--insert-at-split previous citation 2 previous-punct-re)) 1110 (final-punct 1111 (org-cite--move-punct-before final-punct citation next info)) 1112 ;; There is only punct, and we're already after it. 1113 (t nil))) 1114 (`(,_ inside before) 1115 ;; Citation is already behind final-punct, so only consider 1116 ;; other locations. 1117 (when (or punct quote) 1118 (org-cite--insert-at-split previous citation 0 previous-punct-re))) 1119 (`(,_ outside after) 1120 ;; Citation is already after any punct or quote. It can only 1121 ;; move past final punctuation, if there is one. 1122 (when final-punct 1123 (org-cite--move-punct-before final-punct citation next info))) 1124 (`(,_ outside before) 1125 ;; The only non-trivial case is when citation follows punct 1126 ;; without a quote. 1127 (when (and punct (not quote)) 1128 (org-cite--insert-at-split previous citation 0 previous-punct-re))) 1129 (_ 1130 (error "Invalid punctuation rule: %S" rule)))))) 1131 1132 1133 ;;; Tools generating or operating on parsed data 1134 (defun org-cite-parse-elements (s) 1135 "Parse string S as a list of Org elements. 1136 1137 The return value is suitable as a replacement for a 1138 \"print_bibliography\" keyword. As a consequence, the function 1139 raises an error if S contains a headline." 1140 (with-temp-buffer 1141 (insert s) 1142 (pcase (org-element-contents (org-element-parse-buffer)) 1143 ('nil nil) 1144 (`(,(and section (guard (eq 'section (org-element-type section))))) 1145 (org-element-contents section)) 1146 (_ 1147 (error "Headlines cannot replace a keyword"))))) 1148 1149 (defun org-cite-parse-objects (s &optional affix) 1150 "Parse string S as a secondary string. 1151 1152 The return value is suitable as a replacement for a citation object. 1153 1154 When optional argument AFFIX is non-nil, restrict the set of allowed object 1155 types to match the contents of a citation affix." 1156 (org-element-parse-secondary-string 1157 s (org-element-restriction (if affix 'citation-reference 'paragraph)))) 1158 1159 (defun org-cite-make-paragraph (&rest data) 1160 "Return a paragraph element containing DATA. 1161 DATA are strings, objects or secondary strings." 1162 (apply #'org-element-create 'paragraph nil (apply #'org-cite-concat data))) 1163 1164 (defun org-cite-emphasize (type &rest data) 1165 "Apply emphasis TYPE on DATA. 1166 TYPE is a symbol among `bold', `italic', `strike-through' and `underline'. 1167 DATA are strings, objects or secondary strings. Return an object of type TYPE." 1168 (declare (indent 1)) 1169 (unless (memq type '(bold italic strike-through underline)) 1170 (error "Wrong emphasis type: %S" type)) 1171 (apply #'org-element-create type nil (apply #'org-cite-concat data))) 1172 1173 (defun org-cite-concat (&rest data) 1174 "Concatenate all the DATA arguments and make the result a secondary string. 1175 Each argument may be a string, an object, or a secondary string." 1176 (let ((results nil)) 1177 (dolist (datum (reverse data)) 1178 (pcase datum 1179 ('nil nil) 1180 ;; Element or object. 1181 ((pred org-element-type) (push datum results)) 1182 ;; Secondary string. 1183 ((pred consp) (setq results (append datum results))) 1184 (_ 1185 (signal 1186 'wrong-type-argument 1187 (list (format "Argument is not a string or a secondary string: %S" 1188 datum)))))) 1189 results)) 1190 1191 (defun org-cite-mapconcat (function data separator) 1192 "Apply FUNCTION to each element of DATA, and return a secondary string. 1193 1194 In between each pair of results, stick SEPARATOR, which may be a string, 1195 an object, or a secondary string. FUNCTION must be a function of one argument, 1196 and must return either a string, an object, or a secondary string." 1197 (and data 1198 (let ((result (list (funcall function (car data))))) 1199 (dolist (datum (cdr data)) 1200 (setq result 1201 (org-cite-concat result separator (funcall function datum)))) 1202 result))) 1203 1204 1205 ;;; Internal interface with fontification (activate capability) 1206 (defun org-cite-fontify-default (cite) 1207 "Fontify CITE with `org-cite' and `org-cite-key' faces. 1208 CITE is a citation object. The function applies `org-cite' face 1209 on the whole citation, and `org-cite-key' face on each key." 1210 (let ((beg (org-element-property :begin cite)) 1211 (end (org-with-point-at (org-element-property :end cite) 1212 (skip-chars-backward " \t") 1213 (point)))) 1214 (add-text-properties beg end '(font-lock-multiline t)) 1215 (add-face-text-property beg end 'org-cite) 1216 (dolist (reference (org-cite-get-references cite)) 1217 (let ((boundaries (org-cite-key-boundaries reference))) 1218 (add-face-text-property (car boundaries) (cdr boundaries) 1219 'org-cite-key))))) 1220 1221 (defun org-cite-activate (limit) 1222 "Activate citations from up to LIMIT buffer position. 1223 Each citation encountered is activated using the appropriate function 1224 from the processor set in `org-cite-activate-processor'." 1225 (let* ((name org-cite-activate-processor) 1226 (activate 1227 (or (and name 1228 (org-cite-processor-has-capability-p name 'activate) 1229 (org-cite-processor-activate (org-cite-get-processor name))) 1230 #'org-cite-fontify-default))) 1231 (when (re-search-forward org-element-citation-prefix-re limit t) 1232 (let ((cite (org-with-point-at (match-beginning 0) 1233 (org-element-citation-parser)))) 1234 (when cite 1235 (funcall activate cite) 1236 ;; Move after cite object and make sure to return 1237 ;; a non-nil value. 1238 (goto-char (org-element-property :end cite))))))) 1239 1240 1241 ;;; Internal interface with Org Export library (export capability) 1242 (defun org-cite-store-bibliography (info) 1243 "Store bibliography in the communication channel. 1244 1245 Bibliography is stored as a list of absolute file names in the `:bibliography' 1246 property. 1247 1248 INFO is the communication channel, as a plist. It is modified by side-effect." 1249 (plist-put info :bibliography (org-cite-list-bibliography-files))) 1250 1251 (defun org-cite-store-export-processor (info) 1252 "Store export processor in the `:cite-export' property during export. 1253 1254 Export processor is stored as a triplet, or nil. 1255 1256 When non-nil, it is defined as (NAME BIBLIOGRAPHY-STYLE 1257 CITATION-STYLE) where NAME is a symbol, whereas 1258 BIBLIOGRAPHY-STYLE and CITATION-STYLE are strings, or nil. 1259 1260 INFO is the communication channel, as a plist. It is modified by 1261 side-effect." 1262 (let* ((err 1263 (lambda (s) 1264 (user-error "Invalid cite export processor declaration: %S" s))) 1265 (processor 1266 (pcase (plist-get info :cite-export) 1267 ((or "" `nil) nil) 1268 ;; Value is a string. It comes from a "cite_export" 1269 ;; keyword. 1270 ((and (pred stringp) s) 1271 (org-cite-read-processor-declaration s)) 1272 ;; Value is an alist. It must come from 1273 ;; `org-cite-export-processors' variable. Find the most 1274 ;; appropriate processor according to current export 1275 ;; back-end. 1276 ((and (pred consp) alist) 1277 (let* ((backend (plist-get info :back-end)) 1278 (candidates 1279 ;; Limit candidates to processors associated to 1280 ;; back-ends derived from or equal to the current 1281 ;; one. 1282 (sort (seq-filter 1283 (pcase-lambda (`(,key . ,_)) 1284 (org-export-derived-backend-p backend key)) 1285 alist) 1286 (lambda (a b) 1287 (org-export-derived-backend-p (car a) (car b)))))) 1288 ;; Select the closest candidate, or fallback to t. 1289 (pcase (or (car candidates) (assq t alist)) 1290 ('nil nil) 1291 (`(,_ . ,p) 1292 ;; Normalize value by turning it into a triplet. 1293 (pcase p 1294 (`(,(pred symbolp)) 1295 (append p (list nil nil))) 1296 (`(,(pred symbolp) ,(pred string-or-null-p)) 1297 (append p (list nil))) 1298 (`(,(pred symbolp) 1299 ,(pred string-or-null-p) 1300 ,(pred string-or-null-p)) 1301 p) 1302 (_ (funcall err p)))) 1303 (other (funcall err (cdr other)))))) 1304 (other (funcall err other))))) 1305 (pcase processor 1306 ('nil nil) 1307 (`(,name . ,_) 1308 (org-cite-try-load-processor name) 1309 (cond 1310 ((not (org-cite-get-processor name)) 1311 (user-error "Unknown processor %S" name)) 1312 ((not (org-cite-processor-has-capability-p name 'export)) 1313 (user-error "Processor %S is unable to handle citation export" name))))) 1314 (plist-put info :cite-export processor))) 1315 1316 (defun org-cite-export-citation (citation _ info) 1317 "Export CITATION object according to INFO property list. 1318 This function delegates the export of the current citation to the 1319 selected citation processor." 1320 (pcase (plist-get info :cite-export) 1321 ('nil nil) 1322 (`(,p ,_ ,_) 1323 (funcall (org-cite-processor-export-citation (org-cite-get-processor p)) 1324 citation 1325 (org-cite-citation-style citation info) 1326 (plist-get info :back-end) 1327 info)) 1328 (other (error "Invalid `:cite-export' value: %S" other)))) 1329 1330 (defun org-cite-export-bibliography (keyword _ info) 1331 "Return bibliography associated to \"print_bibliography\" KEYWORD. 1332 BACKEND is the export back-end, as a symbol. INFO is a plist 1333 used as a communication channel." 1334 (pcase (plist-get info :cite-export) 1335 ('nil nil) 1336 (`(,p ,_ ,_) 1337 (let ((export-bibilography 1338 (org-cite-processor-export-bibliography 1339 (org-cite-get-processor p)))) 1340 (when export-bibilography 1341 (funcall export-bibilography 1342 (org-cite-list-keys info) 1343 (plist-get info :bibliography) 1344 (org-cite-bibliography-style info) 1345 (org-cite-bibliography-properties keyword) 1346 (plist-get info :back-end) 1347 info)))) 1348 (other (error "Invalid `:cite-export' value: %S" other)))) 1349 1350 (defun org-cite-process-citations (info) 1351 "Replace all citations in the parse tree. 1352 INFO is the communication channel, as a plist. Parse tree is modified 1353 by side-effect." 1354 (dolist (cite (org-cite-list-citations info)) 1355 (let ((replacement (org-cite-export-citation cite nil info)) 1356 (blanks (or (org-element-property :post-blank cite) 0))) 1357 (if (null replacement) 1358 ;; Before removing the citation, transfer its `:post-blank' 1359 ;; property to the object before, if any. 1360 (org-cite--set-previous-post-blank cite blanks info) 1361 ;; Make sure there is a space between a quotation mark and 1362 ;; a citation. This is particularly important when using 1363 ;; `adaptive' note rule. See `org-cite-note-rules'. 1364 (let ((previous (org-export-get-previous-element cite info))) 1365 (when (and (org-string-nw-p previous) 1366 (string-suffix-p "\"" previous)) 1367 (org-cite--set-previous-post-blank cite 1 info))) 1368 (pcase replacement 1369 ;; String. 1370 ((pred stringp) 1371 ;; Handle `:post-blank' before replacing value. 1372 (let ((output (concat (org-trim replacement) 1373 (make-string blanks ?\s)))) 1374 (org-element-insert-before (org-export-raw-string output) cite))) 1375 ;; Single element. 1376 (`(,(pred symbolp) . ,_) 1377 (org-cite--set-post-blank replacement blanks) 1378 (org-element-insert-before replacement cite)) 1379 ;; Secondary string: splice objects at cite's place. 1380 ;; Transfer `:post-blank' to the last object. 1381 ((pred consp) 1382 (let ((last nil)) 1383 (dolist (datum replacement) 1384 (setq last datum) 1385 (org-element-insert-before datum cite)) 1386 (org-cite--set-post-blank last blanks))) 1387 (_ 1388 (error "Invalid return value from citation export processor: %S" 1389 replacement)))) 1390 (org-element-extract-element cite)))) 1391 1392 (defun org-cite-process-bibliography (info) 1393 "Replace all \"print_bibliography\" keywords in the parse tree. 1394 1395 INFO is the communication channel, as a plist. Parse tree is modified 1396 by side effect." 1397 (org-element-map (plist-get info :parse-tree) 'keyword 1398 (lambda (keyword) 1399 (when (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key keyword)) 1400 (let ((replacement (org-cite-export-bibliography keyword nil info)) 1401 (blanks (or (org-element-property :post-blank keyword) 0))) 1402 (pcase replacement 1403 ;; Before removing the citation, transfer its 1404 ;; `:post-blank' property to the element before, if any. 1405 ('nil 1406 (org-cite--set-previous-post-blank keyword blanks info) 1407 (org-element-extract-element keyword)) 1408 ;; Handle `:post-blank' before replacing keyword with string. 1409 ((pred stringp) 1410 (let ((output (concat (org-element-normalize-string replacement) 1411 (make-string blanks ?\n)))) 1412 (org-element-set-element keyword (org-export-raw-string output)))) 1413 ;; List of elements: splice contents before keyword and 1414 ;; remove the latter. Transfer `:post-blank' to last 1415 ;; element. 1416 ((and `(,(pred listp) . ,_) contents) 1417 (let ((last nil)) 1418 (dolist (datum contents) 1419 (setq last datum) 1420 (org-element-insert-before datum keyword)) 1421 (org-cite--set-post-blank last blanks) 1422 (org-element-extract-element keyword))) 1423 ;; Single element: replace the keyword. 1424 (`(,(pred symbolp) . ,_) 1425 (org-cite--set-post-blank replacement blanks) 1426 (org-element-set-element keyword replacement)) 1427 (_ 1428 (error "Invalid return value from citation export processor: %S" 1429 replacement)))))) 1430 info)) 1431 1432 (defun org-cite-finalize-export (output info) 1433 "Finalizer for export process. 1434 OUTPUT is the full output of the export process. INFO is the communication 1435 channel, as a property list." 1436 (pcase (plist-get info :cite-export) 1437 ('nil output) 1438 (`(,p ,_ ,_) 1439 (let ((finalizer 1440 (org-cite-processor-export-finalizer (org-cite-get-processor p)))) 1441 (if (not finalizer) 1442 output 1443 (funcall finalizer 1444 output 1445 (org-cite-list-keys info) 1446 (plist-get info :bibliography) 1447 (org-cite-bibliography-style info) 1448 (plist-get info :back-end) 1449 info)))) 1450 (other (error "Invalid `:cite-export' value: %S" other)))) 1451 1452 1453 ;;; Internal interface with `org-open-at-point' (follow capability) 1454 (defun org-cite-follow (datum arg) 1455 "Follow citation or citation-reference DATUM. 1456 Following is done according to the processor set in `org-cite-follow-processor'. 1457 ARG is the prefix argument received when calling `org-open-at-point', or nil." 1458 (unless org-cite-follow-processor 1459 (user-error "No processor set to follow citations")) 1460 (org-cite-try-load-processor org-cite-follow-processor) 1461 (let ((name org-cite-follow-processor)) 1462 (cond 1463 ((not (org-cite-get-processor name)) 1464 (user-error "Unknown processor %S" name)) 1465 ((not (org-cite-processor-has-capability-p name 'follow)) 1466 (user-error "Processor %S cannot follow citations" name)) 1467 (t 1468 (let ((follow (org-cite-processor-follow (org-cite-get-processor name)))) 1469 (funcall follow datum arg)))))) 1470 1471 1472 ;;; Meta-command for citation insertion (insert capability) 1473 (defun org-cite--allowed-p (context) 1474 "Non-nil when a citation can be inserted at point. 1475 CONTEXT is the element or object at point, as returned by `org-element-context'." 1476 (let ((type (org-element-type context))) 1477 (cond 1478 ;; No citation in attributes, except in parsed ones. 1479 ;; 1480 ;; XXX: Inserting citation in a secondary value is not allowed 1481 ;; yet. Is it useful? 1482 ((let ((post (org-element-property :post-affiliated context))) 1483 (and post (< (point) post))) 1484 (let ((case-fold-search t)) 1485 (looking-back 1486 (rx-to-string 1487 `(seq line-start (0+ (any " \t")) 1488 "#+" 1489 (or ,@org-element-parsed-keywords) 1490 ":" 1491 (0+ nonl)) 1492 t) 1493 (line-beginning-position)))) 1494 ;; Paragraphs and blank lines at top of document are fine. 1495 ((memq type '(nil paragraph))) 1496 ;; So are contents of verse blocks. 1497 ((eq type 'verse-block) 1498 (and (>= (point) (org-element-property :contents-begin context)) 1499 (< (point) (org-element-property :contents-end context)))) 1500 ;; In an headline or inlinetask, point must be either on the 1501 ;; heading itself or on the blank lines below. 1502 ((memq type '(headline inlinetask)) 1503 (or (not (org-at-heading-p)) 1504 (and (save-excursion 1505 (beginning-of-line) 1506 (and (let ((case-fold-search t)) 1507 (not (looking-at-p "\\*+ END[ \t]*$"))) 1508 (let ((case-fold-search nil)) 1509 (looking-at org-complex-heading-regexp)))) 1510 (>= (point) (or 1511 ;; Real heading. 1512 (match-beginning 4) 1513 ;; If no heading, end of priority. 1514 (match-end 3) 1515 ;; ... end of todo keyword. 1516 (match-end 2) 1517 ;; ... after stars. 1518 (1+ (match-end 1)))) 1519 (or (not (match-beginning 5)) 1520 (< (point) (match-beginning 5)))))) 1521 ;; White spaces after an object or blank lines after an element 1522 ;; are OK. 1523 ((>= (point) 1524 (save-excursion (goto-char (org-element-property :end context)) 1525 (skip-chars-backward " \r\t\n") 1526 (if (eq (org-element-class context) 'object) (point) 1527 (line-beginning-position 2))))) 1528 ;; At the beginning of a footnote definition, right after the 1529 ;; label, is OK. 1530 ((eq type 'footnote-definition) (looking-at (rx space))) 1531 ;; At the start of a list item is fine, as long as the bullet is 1532 ;; unaffected. 1533 ((eq type 'item) 1534 (> (point) (+ (org-element-property :begin context) 1535 (org-current-text-indentation) 1536 (if (org-element-property :checkbox context) 1537 5 1)))) 1538 ;; Other elements are invalid. 1539 ((eq (org-element-class context) 'element) nil) 1540 ;; Just before object is fine. 1541 ((= (point) (org-element-property :begin context))) 1542 ;; Within recursive object too, but not in a link. 1543 ((eq type 'link) nil) 1544 ((eq type 'table-cell) 1545 ;; :contents-begin is not reliable on empty cells, so special 1546 ;; case it. 1547 (<= (save-excursion (skip-chars-backward " \t") (point)) 1548 (org-element-property :contents-end context))) 1549 ((let ((cbeg (org-element-property :contents-begin context)) 1550 (cend (org-element-property :contents-end context))) 1551 (and cbeg (>= (point) cbeg) (<= (point) cend))))))) 1552 1553 (defun org-cite--insert-string-before (string reference) 1554 "Insert STRING before citation REFERENCE object." 1555 (org-with-point-at (org-element-property :begin reference) 1556 (insert string ";"))) 1557 1558 (defun org-cite--insert-string-after (string reference) 1559 "Insert STRING after citation REFERENCE object." 1560 (org-with-point-at (org-element-property :end reference) 1561 ;; Make sure to move forward when we're inserting at point, so the 1562 ;; insertion can happen multiple times. 1563 (if (char-equal ?\; (char-before)) 1564 (insert-before-markers string ";") 1565 (insert-before-markers ";" string)))) 1566 1567 (defun org-cite--keys-to-citation (keys) 1568 "Build a citation object from a list of citation KEYS. 1569 Citation keys are strings without the leading \"@\"." 1570 (apply #'org-element-create 1571 'citation 1572 nil 1573 (mapcar (lambda (k) 1574 (org-element-create 'citation-reference (list :key k))) 1575 keys))) 1576 1577 (defun org-cite-make-insert-processor (select-key select-style) 1578 "Build a function appropriate as an insert processor. 1579 1580 SELECT-KEY is a function called with one argument. When it is 1581 nil, the function should return a citation key as a string, or 1582 nil. Otherwise, the function should return a list of such keys, 1583 or nil. The keys should not have any leading \"@\" character. 1584 1585 SELECT-STYLE is a function called with one argument, the citation 1586 object being edited or constructed so far. It should return 1587 a style string, or nil. 1588 1589 The return value is a function of two arguments: CONTEXT and ARG. 1590 CONTEXT is either a citation reference, a citation object, or 1591 nil. ARG is a prefix argument. 1592 1593 The generated function inserts or edits a citation at point. 1594 More specifically, 1595 1596 On a citation reference: 1597 1598 - on the prefix or right before the \"@\" character, insert 1599 a new reference before the current one, 1600 - on the suffix, insert it after the reference, 1601 - otherwise, update the cite key, preserving both affixes. 1602 1603 When ARG is non-nil, remove the reference, possibly removing 1604 the whole citation if it contains a single reference. 1605 1606 On a citation object: 1607 1608 - on the style part, offer to update it, 1609 - on the global prefix, add a new reference before the first 1610 one, 1611 - on the global suffix, add a new reference after the last 1612 one. 1613 1614 Elsewhere, insert a citation at point. When ARG is non-nil, 1615 offer to complete style in addition to references." 1616 (unless (and (functionp select-key) (functionp select-style)) 1617 (error "Wrong argument type(s)")) 1618 (lambda (context arg) 1619 (pcase (org-element-type context) 1620 ;; When on a citation, check point is not on the blanks after it. 1621 ;; Otherwise, consider we're after it. 1622 ((and 'citation 1623 (guard 1624 (let ((boundaries (org-cite-boundaries context))) 1625 (and (< (point) (cdr boundaries)) 1626 (> (point) (car boundaries)))))) 1627 ;; When ARG is non-nil, delete the whole citation. Otherwise, 1628 ;; action depends on the point. 1629 (if arg 1630 (org-cite-delete-citation context) 1631 (let* ((begin (org-element-property :begin context)) 1632 (style-end (1- (org-with-point-at begin (search-forward ":"))))) 1633 (if (>= style-end (point)) 1634 ;; On style part, edit the style. 1635 (let ((style-start (+ 5 begin)) 1636 (style (funcall select-style context))) 1637 (unless style (user-error "Aborted")) 1638 (org-with-point-at style-start 1639 (delete-region style-start style-end) 1640 (when (org-string-nw-p style) (insert "/" style)))) 1641 ;; On an affix, insert a new reference before or after 1642 ;; point. 1643 (let* ((references (org-cite-get-references context)) 1644 (key (concat "@" (funcall select-key nil)))) 1645 (if (< (point) (org-element-property :contents-begin context)) 1646 (org-cite--insert-string-before key (car references)) 1647 (org-cite--insert-string-after key (org-last references)))))))) 1648 ;; On a citation reference. If ARG is not nil, remove the 1649 ;; reference. Otherwise, action depends on the point. 1650 ((and 'citation-reference (guard arg)) (org-cite-delete-citation context)) 1651 ('citation-reference 1652 (pcase-let* ((`(,start . ,end) (org-cite-key-boundaries context)) 1653 (key (concat "@" 1654 (or (funcall select-key nil) 1655 (user-error "Aborted"))))) 1656 ;; Right before the "@" character, do not replace the reference 1657 ;; at point, but insert a new one before it. It makes adding 1658 ;; a new reference at the beginning easier in the following 1659 ;; case: [cite:@key]. 1660 (cond 1661 ((>= start (point)) (org-cite--insert-string-before key context)) 1662 ((<= end (point)) (org-cite--insert-string-after key context)) 1663 (t 1664 (org-with-point-at start 1665 (delete-region start end) 1666 (insert key)))))) 1667 (_ 1668 (let ((keys (funcall select-key t))) 1669 (unless keys (user-error "Aborted")) 1670 (insert 1671 (format "[cite%s:%s]" 1672 (if arg 1673 (let ((style (funcall select-style 1674 (org-cite--keys-to-citation keys)))) 1675 (if (org-string-nw-p style) 1676 (concat "/" style) 1677 "")) 1678 "") 1679 (mapconcat (lambda (k) (concat "@" k)) keys "; ")))))))) 1680 1681 ;;;###autoload 1682 (defun org-cite-insert (arg) 1683 "Insert a citation at point. 1684 Insertion is done according to the processor set in `org-cite-insert-processor'. 1685 ARG is the prefix argument received when calling interactively the function." 1686 (interactive "P") 1687 (unless org-cite-insert-processor 1688 (user-error "No processor set to insert citations")) 1689 (org-cite-try-load-processor org-cite-insert-processor) 1690 (let ((name org-cite-insert-processor)) 1691 (cond 1692 ((not (org-cite-get-processor name)) 1693 (user-error "Unknown processor %S" name)) 1694 ((not (org-cite-processor-has-capability-p name 'insert)) 1695 (user-error "Processor %S cannot insert citations" name)) 1696 (t 1697 (let ((context (org-element-context)) 1698 (insert (org-cite-processor-insert (org-cite-get-processor name)))) 1699 (cond 1700 ((memq (org-element-type context) '(citation citation-reference)) 1701 (funcall insert context arg)) 1702 ((org-cite--allowed-p context) 1703 (funcall insert nil arg)) 1704 (t 1705 (user-error "Cannot insert a citation here")))))))) 1706 1707 (provide 'oc) 1708 ;;; oc.el ends here