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