oc-basic.el (39124B)
1 ;;; oc-basic.el --- basic backend for citations -*- 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 ;; The `basic' citation processor provides "activate", "follow", "export" and 25 ;; "insert" capabilities. 26 27 ;; "activate" capability reuses default fontification, but provides additional 28 ;; features on both correct and wrong keys according to the bibliography 29 ;; defined in the document. 30 31 ;; When the mouse is over a known key, it displays the corresponding 32 ;; bibliography entry. Any wrong key, however, is highlighted with `error' 33 ;; face. Moreover, moving the mouse onto it displays a list of suggested correct 34 ;; keys, and pressing <mouse-1> on the faulty key will try to fix it according to 35 ;; those suggestions. 36 37 ;; On a citation key, "follow" capability moves point to the corresponding entry 38 ;; in the current bibliography. Elsewhere on the citation, it asks the user to 39 ;; follow any of the keys cited there, with completion. 40 41 ;; "export" capability supports the following citation styles: 42 ;; 43 ;; - author (a), including caps (c) variant, 44 ;; - noauthor (na) including bare (b) variant, 45 ;; - text (t), including bare (b), caps (c), and bare-caps (bc) variants, 46 ;; - note (ft, including bare (b), caps (c), and bare-caps (bc) variants, 47 ;; - nocite (n) 48 ;; - numeric (nb), 49 ;; - default, including bare (b), caps (c), and bare-caps (bc) variants. 50 ;; 51 ;; It also supports the following styles for bibliography: 52 ;; - plain 53 ;; - numeric 54 ;; - author-year (default) 55 56 ;; "insert" capability inserts or edits (with completion) citation style or 57 ;; citation reference keys. In an appropriate place, it offers to insert a new 58 ;; citation. With a prefix argument, it removes the one at point. 59 60 ;; It supports bibliography files in BibTeX (".bibtex"), biblatex (".bib") and 61 ;; JSON (".json") format. 62 63 ;; Disclaimer: this citation processor is meant to be a proof of concept, and 64 ;; possibly a fall-back mechanism when nothing else is available. It is too 65 ;; limited for any serious use case. 66 67 ;;; Code: 68 69 (require 'org-macs) 70 (org-assert-version) 71 72 (require 'bibtex) 73 (require 'json) 74 (require 'map) 75 (require 'oc) 76 (require 'seq) 77 78 (declare-function org-open-at-point "org" (&optional arg)) 79 (declare-function org-open-file "org" (path &optional in-emacs line search)) 80 81 (declare-function org-element-create "org-element-ast" (type &optional props &rest children)) 82 (declare-function org-element-set "org-element-ast" (old new &optional keep-props)) 83 84 (declare-function org-element-interpret-data "org-element" (data)) 85 (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) 86 (declare-function org-element-map "org-element" 87 ( data types fun 88 &optional 89 info first-match no-recursion 90 with-affiliated no-undefer)) 91 (declare-function org-element-property "org-element-ast" (property node)) 92 (declare-function org-element-type-p "org-element-ast" (node types)) 93 (declare-function org-element-contents "org-element-ast" (node)) 94 95 (declare-function org-export-data "org-export" (data info)) 96 (declare-function org-export-derived-backend-p "org-export" (backend &rest backends)) 97 (declare-function org-export-raw-string "org-export" (contents)) 98 99 100 ;;; Customization 101 (defcustom org-cite-basic-sorting-field 'author 102 "Field used to sort bibliography items as a symbol, or nil." 103 :group 'org-cite 104 :package-version '(Org . "9.5") 105 :type 'symbol 106 :safe #'symbolp) 107 108 (defcustom org-cite-basic-author-year-separator ", " 109 "String used to separate cites in an author-year configuration." 110 :group 'org-cite 111 :package-version '(Org . "9.5") 112 :type 'string 113 :safe #'stringp) 114 115 (defcustom org-cite-basic-max-key-distance 2 116 "Maximum (Levenshtein) distance between a wrong key and its suggestions." 117 :group 'org-cite 118 :package-version '(Org . "9.5") 119 :type 'integer 120 :safe #'integerp) 121 122 (defcustom org-cite-basic-author-column-end 25 123 "Column where author field ends in completion table, as an integer." 124 :group 'org-cite 125 :package-version '(Org . "9.5") 126 :type 'integer 127 :safe #'integerp) 128 129 (defcustom org-cite-basic-column-separator " " 130 "Column separator in completion table, as a string." 131 :group 'org-cite 132 :package-version '(Org . "9.5") 133 :type 'string 134 :safe #'stringp) 135 136 (defcustom org-cite-basic-mouse-over-key-face 'highlight 137 "Face used when mouse is over a citation key." 138 :group 'org-cite 139 :package-version '(Org . "9.5") 140 :type 'face 141 :safe #'facep) 142 143 144 ;;; Internal variables 145 (defvar org-cite-basic--bibliography-cache nil 146 "Cache for parsed bibliography files. 147 148 This is an association list following the pattern: 149 150 (FILE-ID . ENTRIES) 151 152 FILE-ID is a cons cell (FILE . HASH), with FILE being the absolute file name of 153 the bibliography file, and HASH a hash of its contents. 154 155 ENTRIES is a hash table with citation references as keys and fields alist as 156 values.") 157 158 (defvar org-cite-basic--completion-cache (make-hash-table :test #'equal) 159 "Cache for key completion table. 160 161 This is an a hash-table.") 162 163 164 ;;; Internal functions 165 (defun org-cite-basic--parse-json () 166 "Parse JSON entries in the current buffer. 167 Return a hash table with citation references as keys and fields alist as values." 168 (let ((entries (make-hash-table :test #'equal))) 169 (let ((json-array-type 'list) 170 (json-key-type 'symbol)) 171 (dolist (item (json-read)) 172 (puthash (cdr (assq 'id item)) 173 (mapcar (pcase-lambda (`(,field . ,value)) 174 (pcase field 175 ((or 'author 'editor) 176 ;; Author and editors are arrays of 177 ;; objects, each of them designing a 178 ;; person. These objects may contain 179 ;; multiple properties, but for this 180 ;; basic processor, we'll focus on 181 ;; `given' and `family'. 182 ;; 183 ;; For compatibility with BibTeX, add 184 ;; "and" between authors and editors. 185 (cons field 186 (mapconcat 187 (lambda (alist) 188 (concat (alist-get 'family alist) 189 " " 190 (alist-get 'given alist))) 191 value 192 " and "))) 193 ('issued 194 ;; Date are expressed as an array 195 ;; (`date-parts') or a "string (`raw' 196 ;; or `literal'). In both cases, 197 ;; extract the year and associate it 198 ;; to `year' field, for compatibility 199 ;; with BibTeX format. 200 (let ((date (or (alist-get 'date-parts value) 201 (alist-get 'literal value) 202 (alist-get 'raw value)))) 203 (cons 'year 204 (cond 205 ((consp date) 206 (let ((year (caar date))) 207 (cond 208 ((numberp year) (number-to-string year)) 209 ((stringp year) year) 210 (t 211 (error 212 "First element of CSL-JSON date-parts should be a number or string, got %s: %S" 213 (type-of year) year))))) 214 ((stringp date) 215 (replace-regexp-in-string 216 (rx 217 (minimal-match (zero-or-more anything)) 218 (group-n 1 (repeat 4 digit)) 219 (zero-or-more anything)) 220 (rx (backref 1)) 221 date)) 222 (t 223 (error "Unknown CSL-JSON date format: %S" 224 value)))))) 225 (_ 226 (cons field value)))) 227 item) 228 entries)) 229 entries))) 230 231 (defun org-cite-basic--parse-bibtex (dialect) 232 "Parse BibTeX entries in the current buffer. 233 DIALECT is the BibTeX dialect used. See `bibtex-dialect'. 234 Return a hash table with citation references as keys and fields alist as values." 235 (let ((entries (make-hash-table :test #'equal)) 236 (bibtex-sort-ignore-string-entries t)) 237 (bibtex-set-dialect dialect t) 238 ;; Throw an error if bibliography is malformed. 239 (unless (bibtex-validate) 240 (user-error "Malformed bibliography at %S" 241 (or (buffer-file-name) (current-buffer)))) 242 (bibtex-map-entries 243 (lambda (key &rest _) 244 ;; Normalize entries: field names are turned into symbols 245 ;; including special "=key=" and "=type=", and consecutive 246 ;; white spaces are removed from values. 247 (puthash key 248 (mapcar 249 (pcase-lambda (`(,field . ,value)) 250 (pcase field 251 ("=key=" (cons 'id key)) 252 ("=type=" (cons 'type value)) 253 (_ 254 (cons 255 (intern (downcase field)) 256 (replace-regexp-in-string "[ \t\n]+" " " value))))) 257 ;; Parse, substituting the @string replacements. 258 ;; See Emacs bug#56475 discussion. 259 (let ((bibtex-string-files `(,(buffer-file-name))) 260 (bibtex-expand-strings t)) 261 (bibtex-parse-entry t))) 262 entries))) 263 entries)) 264 265 (defvar org-cite-basic--file-id-cache nil 266 "Hash table linking files to their hash.") 267 (defun org-cite-basic--parse-bibliography (&optional info) 268 "List all entries available in the buffer. 269 270 Each association follows the pattern 271 272 (FILE . ENTRIES) 273 274 where FILE is the absolute file name of the BibTeX file, and ENTRIES is a hash 275 table where keys are references and values are association lists between fields, 276 as symbols, and values as strings or nil. 277 278 Optional argument INFO is the export state, as a property list." 279 (unless (hash-table-p org-cite-basic--file-id-cache) 280 (setq org-cite-basic--file-id-cache (make-hash-table :test #'equal))) 281 (if (plist-member info :cite-basic/bibliography) 282 (plist-get info :cite-basic/bibliography) 283 (let ((results nil)) 284 (dolist (file (org-cite-list-bibliography-files)) 285 ;; Follow symlinks, to look into modification time of the 286 ;; actual file, not its symlink. 287 (setq file (file-truename file)) 288 (when (file-readable-p file) 289 (with-temp-buffer 290 (when (or (org-file-has-changed-p file) 291 (not (gethash file org-cite-basic--file-id-cache))) 292 (insert-file-contents file) 293 (set-visited-file-name file t) 294 (puthash file (org-buffer-hash) org-cite-basic--file-id-cache)) 295 (condition-case nil 296 (unwind-protect 297 (let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache))) 298 (entries 299 (or (cdr (assoc file-id org-cite-basic--bibliography-cache)) 300 (let ((table 301 (pcase (file-name-extension file) 302 ("json" (org-cite-basic--parse-json)) 303 ("bib" (org-cite-basic--parse-bibtex 'biblatex)) 304 ("bibtex" (org-cite-basic--parse-bibtex 'BibTeX)) 305 (ext 306 (user-error "Unknown bibliography extension: %S" 307 ext))))) 308 (push (cons file-id table) org-cite-basic--bibliography-cache) 309 table)))) 310 (push (cons file entries) results)) 311 (set-visited-file-name nil t)) 312 (error (setq org-cite-basic--file-id-cache nil)))))) 313 (when info (plist-put info :cite-basic/bibliography results)) 314 results))) 315 316 (defun org-cite-basic--key-number (key info) 317 "Return number associated to cited KEY. 318 INFO is the export state, as a property list." 319 (let ((predicate 320 (org-cite-basic--field-less-p org-cite-basic-sorting-field info))) 321 (org-cite-key-number key info predicate))) 322 323 (defun org-cite-basic--all-keys () 324 "List all keys available in current bibliography." 325 (seq-mapcat (pcase-lambda (`(,_ . ,entries)) 326 (map-keys entries)) 327 (org-cite-basic--parse-bibliography))) 328 329 (defun org-cite-basic--get-entry (key &optional info) 330 "Return BibTeX entry for KEY, as an association list. 331 When non-nil, INFO is the export state, as a property list." 332 (catch :found 333 (pcase-dolist (`(,_ . ,entries) (org-cite-basic--parse-bibliography info)) 334 (let ((entry (gethash key entries))) 335 (when entry (throw :found entry)))) 336 nil)) 337 338 (defun org-cite-basic--get-field (field entry-or-key &optional info raw) 339 "Return FIELD value for ENTRY-OR-KEY, or nil. 340 341 FIELD is a symbol. ENTRY-OR-KEY is either an association list, as returned by 342 `org-cite-basic--get-entry', or a string representing a citation key. 343 344 Optional argument INFO is the export state, as a property list. 345 346 Return value may be nil or a string. If current export backend is derived 347 from `latex', return a raw string object instead, unless optional 348 argument RAW is non-nil. 349 350 Throw an error if the field value is non-string and non-nil." 351 (let ((value 352 (cdr 353 (assq field 354 (pcase entry-or-key 355 ((pred stringp) 356 (org-cite-basic--get-entry entry-or-key info)) 357 ((pred consp) 358 entry-or-key) 359 (_ 360 (error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key))))))) 361 (when (and value (not (stringp value))) 362 (error "Non-string bibliography field value: %S" value)) 363 (if (and value 364 (not raw) 365 (org-export-derived-backend-p (plist-get info :back-end) 'latex)) 366 (org-export-raw-string value) 367 value))) 368 369 (defun org-cite-basic--shorten-names (names) 370 "Return a list of family names from a list of full NAMES. 371 NAMES can be a string or raw string object. 372 373 To better accomomodate corporate names, this will only shorten 374 personal names of the form \"family, given\"." 375 (let (names-string raw-p) 376 (cond 377 ((stringp names) (setq names-string names)) 378 ((org-element-type-p names 'raw) 379 (setq names-string (mapconcat #'identity (org-element-contents names) "") 380 raw-p t))) 381 (when names-string 382 (setq names-string 383 (mapconcat 384 (lambda (name) 385 (if (eq 1 (length name)) 386 (cdr (split-string name)) 387 (car (split-string name ", ")))) 388 (split-string names-string " and ") 389 ", ")) 390 (if raw-p (org-export-raw-string names-string) 391 names-string)))) 392 393 (defun org-cite-basic--number-to-suffix (n) 394 "Compute suffix associated to number N. 395 This is used for disambiguation." 396 (let ((result nil)) 397 (apply #'string 398 (mapcar (lambda (n) (+ 97 n)) 399 (catch :complete 400 (while t 401 (push (% n 26) result) 402 (setq n (/ n 26)) 403 (cond 404 ((= n 0) (throw :complete result)) 405 ((< n 27) (throw :complete (cons (1- n) result))) 406 ((= n 27) (throw :complete (cons 0 (cons 0 result)))) 407 (t nil)))))))) 408 409 (defun org-cite-basic--get-author (entry-or-key &optional info raw) 410 "Return author associated to ENTRY-OR-KEY. 411 412 ENTRY-OR-KEY, INFO and RAW arguments are the same arguments as 413 used in `org-cite-basic--get-field', which see. 414 415 Author is obtained from the \"author\" field, if available, or 416 from the \"editor\" field otherwise." 417 (or (org-cite-basic--get-field 'author entry-or-key info raw) 418 (org-cite-basic--get-field 'editor entry-or-key info raw))) 419 420 (defun org-cite-basic--get-year (entry-or-key info &optional no-suffix) 421 "Return year associated to ENTRY-OR-KEY. 422 423 ENTRY-OR-KEY is either an association list, as returned by 424 `org-cite-basic--get-entry', or a string representing a citation 425 key. INFO is the export state, as a property list. 426 427 Year is obtained from the \"year\" field, if available, or from 428 the \"date\" field if it starts with a year pattern. 429 430 Unlike `org-cite-basic--get-field', this function disambiguates 431 author-year patterns by adding a letter suffix to the year when 432 necessary, unless optional argument NO-SUFFIX is non-nil." 433 ;; The cache is an association list with the following structure: 434 ;; 435 ;; (AUTHOR-YEAR . KEY-SUFFIX-ALIST). 436 ;; 437 ;; AUTHOR-YEAR is the author year pair associated to current entry 438 ;; or key. 439 ;; 440 ;; KEY-SUFFIX-ALIST is an association (KEY . SUFFIX), where KEY is 441 ;; the cite key, as a string, and SUFFIX is the generated suffix 442 ;; string, or the empty string. 443 (let* ((author (org-cite-basic--get-author entry-or-key info 'raw)) 444 (year 445 (or (org-cite-basic--get-field 'year entry-or-key info 'raw) 446 (let ((date 447 (org-cite-basic--get-field 'date entry-or-key info 'raw))) 448 (and (stringp date) 449 (string-match (rx string-start 450 (group (= 4 digit)) 451 (or string-end (not digit))) 452 date) 453 (match-string 1 date))))) 454 (cache-key (cons author year)) 455 (key 456 (pcase entry-or-key 457 ((pred stringp) entry-or-key) 458 ((pred consp) (cdr (assq 'id entry-or-key))) 459 (_ (error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key)))) 460 (cache (plist-get info :cite-basic/author-date-cache))) 461 (pcase (assoc cache-key cache) 462 ('nil 463 (let ((value (cons cache-key (list (cons key ""))))) 464 (plist-put info :cite-basic/author-date-cache (cons value cache)) 465 year)) 466 (`(,_ . ,alist) 467 (let ((suffix 468 (or (cdr (assoc key alist)) 469 (let ((new (org-cite-basic--number-to-suffix 470 (1- (length alist))))) 471 (push (cons key new) alist) 472 new)))) 473 (if no-suffix year (concat year suffix))))))) 474 475 (defun org-cite-basic--print-bibtex-string (element &optional info) 476 "Print Bibtex formatted string ELEMENT, according to Bibtex syntax. 477 Remove all the {...} that are not a part of LaTeX macros and parse the 478 LaTeX fragments. Do nothing when current backend is derived from 479 LaTeX, according to INFO. 480 481 Return updated ELEMENT." 482 (if (org-export-derived-backend-p (plist-get info :back-end) 'latex) 483 ;; Derived from LaTeX, no need to use manual ad-hoc LaTeX 484 ;; parser. 485 element 486 ;; Convert ELEMENT to anonymous when ELEMENT is string. 487 ;; Otherwise, we cannot modify ELEMENT by side effect. 488 (when (org-element-type-p element 'plain-text) 489 (setq element (org-element-create 'anonymous nil element))) 490 ;; Approximately parse LaTeX fragments, assuming Org mode syntax 491 ;; (it is close to original LaTeX, and we do not want to 492 ;; re-implement complete LaTeX parser here)) 493 (org-element-map element t 494 (lambda (str) 495 (when (stringp str) 496 (org-element-set 497 str 498 (org-element-parse-secondary-string 499 str '(latex-fragment entity)))))) 500 ;; Strip the remaining { and }. 501 (org-element-map element t 502 (lambda (str) 503 (when (stringp str) 504 (org-element-set str (replace-regexp-in-string "[{}]" "" str))))) 505 element)) 506 507 (defun org-cite-basic--print-entry (entry style &optional info) 508 "Format ENTRY according to STYLE string. 509 ENTRY is an alist, as returned by `org-cite-basic--get-entry'. 510 Optional argument INFO is the export state, as a property list." 511 (let ((author (org-cite-basic--get-author entry info)) 512 (title (org-cite-basic--get-field 'title entry info)) 513 (from 514 (or (org-cite-basic--get-field 'publisher entry info) 515 (org-cite-basic--get-field 'journal entry info) 516 (org-cite-basic--get-field 'institution entry info) 517 (org-cite-basic--get-field 'school entry info)))) 518 (org-cite-basic--print-bibtex-string 519 (pcase style 520 ("plain" 521 (let ((year (org-cite-basic--get-year entry info 'no-suffix))) 522 (org-cite-concat 523 (org-cite-basic--shorten-names author) ". " 524 title (and from (list ", " from)) ", " year "."))) 525 ("numeric" 526 (let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info)) 527 (year (org-cite-basic--get-year entry info 'no-suffix))) 528 (org-cite-concat 529 (format "[%d] " n) author ", " 530 (org-cite-emphasize 'italic title) 531 (and from (list ", " from)) ", " 532 year "."))) 533 ;; Default to author-year. Use year disambiguation there. 534 (_ 535 (let ((year (org-cite-basic--get-year entry info))) 536 (org-cite-concat 537 author " (" year "). " 538 (org-cite-emphasize 'italic title) 539 (and from (list ", " from)) ".")))) 540 info))) 541 542 543 ;;; "Activate" capability 544 (defun org-cite-basic--close-keys (key keys) 545 "List cite keys close to KEY in terms of string distance." 546 (seq-filter (lambda (k) 547 (>= org-cite-basic-max-key-distance 548 (org-string-distance k key))) 549 keys)) 550 551 (defun org-cite-basic--set-keymap (beg end suggestions) 552 "Set keymap on citation key between BEG and END positions. 553 554 When the key is know, SUGGESTIONS is nil. Otherwise, it may be 555 a list of replacement keys, as strings, which will be offered as 556 substitutes for the unknown key. Finally, it may be the symbol 557 `all'." 558 (let ((km (make-sparse-keymap))) 559 (define-key km (kbd "<mouse-1>") 560 (pcase suggestions 561 ('nil #'org-open-at-point) 562 ('all #'org-cite-insert) 563 (_ 564 (lambda () 565 (interactive) 566 (save-excursion 567 (goto-char beg) 568 (delete-region beg end) 569 (insert 570 "@" 571 (if (= 1 (length suggestions)) 572 (car suggestions) 573 (completing-read "Did you mean: " 574 suggestions nil t)))))))) 575 (put-text-property beg end 'keymap km))) 576 577 (defun org-cite-basic-activate (citation) 578 "Set various text properties on CITATION object. 579 580 Fontify whole citation with `org-cite' face. Fontify key with `error' face 581 when it does not belong to known keys. Otherwise, use `org-cite-key' face. 582 583 Moreover, when mouse is on a known key, display the corresponding bibliography. 584 On a wrong key, suggest a list of possible keys, and offer to substitute one of 585 them with a mouse click." 586 (pcase-let ((`(,beg . ,end) (org-cite-boundaries citation)) 587 (keys (org-cite-basic--all-keys))) 588 (put-text-property beg end 'font-lock-multiline t) 589 (add-face-text-property beg end 'org-cite) 590 (dolist (reference (org-cite-get-references citation)) 591 (pcase-let* ((`(,beg . ,end) (org-cite-key-boundaries reference)) 592 (key (org-element-property :key reference))) 593 ;; Highlight key on mouse over. 594 (put-text-property beg end 595 'mouse-face 596 org-cite-basic-mouse-over-key-face) 597 (if (member key keys) 598 ;; Activate a correct key. Face is `org-cite-key' and 599 ;; `help-echo' displays bibliography entry, for reference. 600 ;; <mouse-1> calls `org-open-at-point'. 601 (let* ((entry (org-cite-basic--get-entry key)) 602 (bibliography-entry 603 (org-element-interpret-data 604 (org-cite-basic--print-entry entry "plain")))) 605 (add-face-text-property beg end 'org-cite-key) 606 (put-text-property beg end 'help-echo bibliography-entry) 607 (org-cite-basic--set-keymap beg end nil)) 608 ;; Activate a wrong key. Face is `error', `help-echo' 609 ;; displays possible suggestions. 610 (add-face-text-property beg end 'error) 611 (let ((close-keys (org-cite-basic--close-keys key keys))) 612 (when close-keys 613 (put-text-property beg end 'help-echo 614 (concat "Suggestions (mouse-1 to substitute): " 615 (mapconcat #'identity close-keys " ")))) 616 ;; When the are close know keys, <mouse-1> provides 617 ;; completion to fix the current one. Otherwise, call 618 ;; `org-cite-insert'. 619 (org-cite-basic--set-keymap beg end (or close-keys 'all)))))))) 620 621 622 ;;; "Export" capability 623 (defun org-cite-basic--format-author-year (citation format-cite format-ref info) 624 "Format CITATION object according to author-year format. 625 626 FORMAT-CITE is a function of three arguments: the global prefix, the contents, 627 and the global suffix. All arguments can be strings or secondary strings. 628 629 FORMAT-REF is a function of four arguments: the reference prefix, as a string or 630 secondary string, the author, the year, and the reference suffix, as a string or 631 secondary string. 632 633 INFO is the export state, as a property list." 634 (org-export-data 635 (funcall format-cite 636 (org-element-property :prefix citation) 637 (org-cite-mapconcat 638 (lambda (ref) 639 (let ((k (org-element-property :key ref)) 640 (prefix (org-element-property :prefix ref)) 641 (suffix (org-element-property :suffix ref))) 642 (funcall format-ref 643 prefix 644 (or (org-cite-basic--get-author k info) "??") 645 (or (org-cite-basic--get-year k info) "????") 646 suffix))) 647 (org-cite-get-references citation) 648 org-cite-basic-author-year-separator) 649 (org-element-property :suffix citation)) 650 info)) 651 652 (defun org-cite-basic--citation-numbers (citation info) 653 "Return numbers associated to references in CITATION object. 654 INFO is the export state as a property list." 655 (let* ((numbers 656 (sort (mapcar (lambda (k) (org-cite-basic--key-number k info)) 657 (org-cite-get-references citation t)) 658 #'<)) 659 (last (car numbers)) 660 (result (list (number-to-string (pop numbers))))) 661 ;; Use compact number references, i.e., "1, 2, 3" becomes "1-3". 662 (while numbers 663 (let ((current (pop numbers)) 664 (next (car numbers))) 665 (cond 666 ((and next 667 (= current (1+ last)) 668 (= current (1- next))) 669 (unless (equal "-" (car result)) 670 (push "-" result))) 671 ((equal "-" (car result)) 672 (push (number-to-string current) result)) 673 (t 674 (push (format ", %d" current) result))) 675 (setq last current))) 676 (apply #'concat (nreverse result)))) 677 678 (defun org-cite-basic--field-less-p (field info) 679 "Return a sort predicate comparing FIELD values for two citation keys. 680 INFO is the export state, as a property list." 681 (and field 682 (lambda (a b) 683 (org-string< 684 (org-cite-basic--get-field field a info 'raw) 685 (org-cite-basic--get-field field b info 'raw) 686 nil t)))) 687 688 (defun org-cite-basic--sort-keys (keys info) 689 "Sort KEYS by author name. 690 INFO is the export communication channel, as a property list." 691 (let ((predicate (org-cite-basic--field-less-p org-cite-basic-sorting-field info))) 692 (if predicate 693 (sort keys predicate) 694 keys))) 695 696 (defun org-cite-basic-export-citation (citation style _ info) 697 "Export CITATION object. 698 STYLE is the expected citation style, as a pair of strings or nil. INFO is the 699 export communication channel, as a property list." 700 (let ((has-variant-p 701 (lambda (variant type) 702 ;; Non-nil when style VARIANT has TYPE. TYPE is either 703 ;; `bare' or `caps'. 704 (member variant 705 (pcase type 706 ('bare '("bare" "bare-caps" "b" "bc")) 707 ('caps '("caps" "bare-caps" "c" "bc")) 708 (_ (error "Invalid variant type: %S" type))))))) 709 (pcase style 710 ;; "author" style. 711 (`(,(or "author" "a") . ,variant) 712 (let ((caps (member variant '("caps" "c")))) 713 (org-cite-basic--format-author-year 714 citation 715 (lambda (p c s) (org-cite-concat p c s)) 716 (lambda (prefix author _ suffix) 717 (org-cite-concat 718 prefix 719 (if caps (org-cite-capitalize author) author) 720 suffix)) 721 info))) 722 ;; "noauthor" style. 723 (`(,(or "noauthor" "na") . ,variant) 724 (let ((bare? (funcall has-variant-p variant 'bare))) 725 (org-cite-basic--format-author-year 726 citation 727 (lambda (prefix contents suffix) 728 (org-cite-concat 729 (unless bare? "(") 730 prefix 731 contents 732 suffix 733 (unless bare? ")"))) 734 (lambda (prefix _ year suffix) 735 (org-cite-concat prefix year suffix)) 736 info))) 737 ;; "nocite" style. 738 (`(,(or "nocite" "n") . ,_) nil) 739 ;; "text" and "note" styles. 740 (`(,(and (or "text" "note" "t" "ft") style) . ,variant) 741 (when (and (member style '("note" "ft")) 742 (not (org-cite-inside-footnote-p citation))) 743 (org-cite-adjust-note citation info) 744 (org-cite-wrap-citation citation info)) 745 (let ((bare (funcall has-variant-p variant 'bare)) 746 (caps (funcall has-variant-p variant 'caps))) 747 (org-cite-basic--format-author-year 748 citation 749 (lambda (p c s) (org-cite-concat p c s)) 750 (lambda (p a y s) 751 (org-cite-concat p 752 (if caps (org-cite-capitalize a) a) 753 (if bare " " " (") 754 y 755 (and (not bare) ")") 756 s)) 757 info))) 758 ;; "numeric" style. 759 ;; 760 ;; When using this style on citations with multiple references, 761 ;; use global affixes and ignore local ones. 762 (`(,(or "numeric" "nb") . ,_) 763 (pcase-let ((`(,prefix . ,suffix) (org-cite-main-affixes citation))) 764 (org-export-data 765 (org-cite-concat 766 "(" prefix (org-cite-basic--citation-numbers citation info) suffix ")") 767 info))) 768 ;; Default ("nil") style. 769 (`(,_ . ,variant) 770 (let ((bare (funcall has-variant-p variant 'bare)) 771 (caps (funcall has-variant-p variant 'caps))) 772 (org-cite-basic--format-author-year 773 citation 774 (lambda (p c s) 775 (org-cite-concat (and (not bare) "(") p c s (and (not bare) ")"))) 776 (lambda (p a y s) 777 (org-cite-concat p (if caps (org-cite-capitalize a) a) ", " y s)) 778 info))) 779 ;; This should not happen. 780 (_ (error "Invalid style: %S" style))))) 781 782 (defun org-cite-basic-export-bibliography (keys _files style _props backend info) 783 "Generate bibliography. 784 KEYS is the list of cited keys, as strings. STYLE is the expected bibliography 785 style, as a string. BACKEND is the export backend, as a symbol. INFO is the 786 export state, as a property list." 787 (mapconcat 788 (lambda (entry) 789 (org-export-data 790 (org-cite-make-paragraph 791 (and (org-export-derived-backend-p backend 'latex) 792 (org-export-raw-string "\\noindent\n")) 793 (org-cite-basic--print-entry entry style info)) 794 info)) 795 (delq nil 796 (mapcar 797 (lambda (k) (org-cite-basic--get-entry k info)) 798 (org-cite-basic--sort-keys keys info))) 799 "\n")) 800 801 802 ;;; "Follow" capability 803 (defun org-cite-basic-goto (datum _) 804 "Follow citation or citation reference DATUM. 805 When DATUM is a citation reference, open bibliography entry referencing 806 the citation key. Otherwise, select which key to follow among all keys 807 present in the citation." 808 (let* ((key 809 (if (org-element-type-p datum 'citation-reference) 810 (org-element-property :key datum) 811 (pcase (org-cite-get-references datum t) 812 (`(,key) key) 813 (keys 814 (or (completing-read "Select citation key: " keys nil t) 815 (user-error "Aborted")))))) 816 (file 817 (pcase (seq-find (pcase-lambda (`(,_ . ,entries)) 818 (gethash key entries)) 819 (org-cite-basic--parse-bibliography)) 820 (`(,f . ,_) f) 821 (_ (user-error "Cannot find citation key: %S" key))))) 822 (org-open-file file '(4)) 823 (pcase (file-name-extension file) 824 ("json" 825 ;; `rx' can not be used with Emacs <27.1 since `literal' form 826 ;; is not supported. 827 (let ((regexp (rx-to-string `(seq "\"id\":" (0+ (any "[ \t]")) "\"" ,key "\"") t))) 828 (goto-char (point-min)) 829 (re-search-forward regexp) 830 (search-backward "{"))) 831 (_ 832 (bibtex-set-dialect) 833 (bibtex-search-entry key))))) 834 835 836 ;;; "Insert" capability 837 (defun org-cite-basic--complete-style (_) 838 "Offer completion for style. 839 Return chosen style as a string." 840 (let* ((styles 841 (mapcar (pcase-lambda (`((,style . ,_) . ,_)) 842 style) 843 (org-cite-supported-styles)))) 844 (pcase styles 845 (`(,style) style) 846 (_ (completing-read "Style (\"\" for default): " styles nil t))))) 847 848 (defun org-cite-basic--key-completion-table () 849 "Return completion table for cite keys, as a hash table. 850 851 In this hash table, keys are a strings with author, date, and 852 title of the reference. Values are the cite keys. 853 854 Return nil if there are no bibliography files or no entries." 855 ;; Populate bibliography cache. 856 (let ((entries (org-cite-basic--parse-bibliography))) 857 (cond 858 ((null entries) nil) ;no bibliography files 859 ((gethash entries org-cite-basic--completion-cache) 860 org-cite-basic--completion-cache) 861 (t 862 (clrhash org-cite-basic--completion-cache) 863 (dolist (key (org-cite-basic--all-keys)) 864 (let* ((entry (org-cite-basic--get-entry 865 key 866 ;; Supply pre-calculated bibliography to avoid 867 ;; performance degradation. 868 (list :cite-basic/bibliography entries))) 869 (completion 870 (concat 871 (let ((author (org-cite-basic--get-author entry nil 'raw))) 872 (if author 873 (truncate-string-to-width 874 (replace-regexp-in-string " and " "; " author) 875 org-cite-basic-author-column-end nil ?\s) 876 (make-string org-cite-basic-author-column-end ?\s))) 877 org-cite-basic-column-separator 878 (let ((date (org-cite-basic--get-year entry nil 'no-suffix))) 879 (format "%4s" (or date ""))) 880 org-cite-basic-column-separator 881 (org-cite-basic--get-field 'title entry nil 'raw)))) 882 (puthash completion key org-cite-basic--completion-cache))) 883 (unless (map-empty-p org-cite-basic--completion-cache) ;no key 884 (puthash entries t org-cite-basic--completion-cache) 885 org-cite-basic--completion-cache))))) 886 887 (defun org-cite-basic--complete-key (&optional multiple) 888 "Prompt for a reference key and return a citation reference string. 889 890 When optional argument MULTIPLE is non-nil, prompt for multiple 891 keys, until one of them is nil. Then return the list of 892 reference strings selected. 893 894 Raise an error when no bibliography is set in the buffer." 895 (let* ((table 896 (or (org-cite-basic--key-completion-table) 897 (user-error "No bibliography set"))) 898 (prompt 899 (lambda (text) 900 (completing-read text table nil t)))) 901 (if (null multiple) 902 (let ((key (gethash (funcall prompt "Key: ") table))) 903 (org-string-nw-p key)) 904 (let* ((keys nil) 905 (build-prompt 906 (lambda () 907 (if keys 908 (format "Key (empty input exits) %s: " 909 (mapconcat #'identity (reverse keys) ";")) 910 "Key (empty input exits): ")))) 911 (let ((key (funcall prompt (funcall build-prompt)))) 912 (while (org-string-nw-p key) 913 (push (gethash key table) keys) 914 (setq key (funcall prompt (funcall build-prompt))))) 915 keys)))) 916 917 918 ;;; Register processor 919 (org-cite-register-processor 'basic 920 :activate #'org-cite-basic-activate 921 :export-citation #'org-cite-basic-export-citation 922 :export-bibliography #'org-cite-basic-export-bibliography 923 :follow #'org-cite-basic-goto 924 :insert (org-cite-make-insert-processor #'org-cite-basic--complete-key 925 #'org-cite-basic--complete-style) 926 :cite-styles 927 '((("author" "a") ("caps" "c")) 928 (("noauthor" "na") ("bare" "b")) 929 (("nocite" "n")) 930 (("note" "ft") ("bare-caps" "bc") ("caps" "c")) 931 (("numeric" "nb")) 932 (("text" "t") ("bare-caps" "bc") ("caps" "c")) 933 (("nil") ("bare" "b") ("bare-caps" "bc") ("caps" "c")))) 934 935 (provide 'oc-basic) 936 ;;; oc-basic.el ends here