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