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