123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862 |
- ;;; oc-basic.el --- basic back-end for citations -*- lexical-binding: t; -*-
- ;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
- ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
- ;; This file is part of GNU Emacs.
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; The `basic' citation processor provides "activate", "follow", "export" and
- ;; "insert" capabilities.
- ;; "activate" capability re-uses default fontification, but provides additional
- ;; features on both correct and wrong keys according to the bibliography
- ;; defined in the document.
- ;; When the mouse is over a known key, it displays the corresponding
- ;; bibliography entry. Any wrong key, however, is highlighted with `error'
- ;; face. Moreover, moving the mouse onto it displays a list of suggested correct
- ;; keys, and pressing <mouse-1> on the faulty key will try to fix it according to
- ;; those suggestions.
- ;; On a citation key, "follow" capability moves point to the corresponding entry
- ;; in the current bibliography. Elsewhere on the citation, it asks the user to
- ;; follow any of the keys cited there, with completion.
- ;; "export" capability supports the following citation styles:
- ;;
- ;; - author (a), including caps (c) variant,
- ;; - noauthor (na) including bare (b) variant,
- ;; - text (t), including bare (b), caps (c), and bare-caps (bc) variants,
- ;; - note (ft, including bare (b), caps (c), and bare-caps (bc) variants,
- ;; - nocite (n)
- ;; - numeric (nb),
- ;; - default, including bare (b), caps (c), and bare-caps (bc) variants.
- ;;
- ;; It also supports the following styles for bibliography:
- ;; - plain
- ;; - numeric
- ;; - author-year (default)
- ;; "insert" capability inserts or edits (with completion) citation style or
- ;; citation reference keys. In an appropriate place, it offers to insert a new
- ;; citation. With a prefix argument, it removes the one at point.
- ;; It supports bibliography files in BibTeX (".bibtex"), biblatex (".bib") and
- ;; JSON (".json") format.
- ;; Disclaimer: this citation processor is meant to be a proof of concept, and
- ;; possibly a fall-back mechanism when nothing else is available. It is too
- ;; limited for any serious use case.
- ;;; Code:
- (require 'org-macs)
- (org-assert-version)
- (require 'bibtex)
- (require 'json)
- (require 'map)
- (require 'oc)
- (require 'seq)
- (declare-function org-open-at-point "org" (&optional arg))
- (declare-function org-open-file "org" (path &optional in-emacs line search))
- (declare-function org-element-interpret-data "org-element" (data))
- (declare-function org-element-property "org-element" (property element))
- (declare-function org-element-type "org-element" (element))
- (declare-function org-export-data "org-export" (data info))
- (declare-function org-export-derived-backend-p "org-export" (backend &rest backends))
- (declare-function org-export-raw-string "org-export" (contents))
- ;;; Customization
- (defcustom org-cite-basic-sorting-field 'author
- "Field used to sort bibliography items as a symbol, or nil."
- :group 'org-cite
- :package-version '(Org . "9.5")
- :type 'symbol
- :safe #'symbolp)
- (defcustom org-cite-basic-author-year-separator ", "
- "String used to separate cites in an author-year configuration."
- :group 'org-cite
- :package-version '(Org . "9.5")
- :type 'string
- :safe #'stringp)
- (defcustom org-cite-basic-max-key-distance 2
- "Maximum (Levenshtein) distance between a wrong key and its suggestions."
- :group 'org-cite
- :package-version '(Org . "9.5")
- :type 'integer
- :safe #'integerp)
- (defcustom org-cite-basic-author-column-end 25
- "Column where author field ends in completion table, as an integer."
- :group 'org-cite
- :package-version '(Org . "9.5")
- :type 'integer
- :safe #'integerp)
- (defcustom org-cite-basic-column-separator " "
- "Column separator in completion table, as a string."
- :group 'org-cite
- :package-version '(Org . "9.5")
- :type 'string
- :safe #'stringp)
- (defcustom org-cite-basic-mouse-over-key-face 'highlight
- "Face used when mouse is over a citation key."
- :group 'org-cite
- :package-version '(Org . "9.5")
- :type 'face
- :safe #'facep)
- ;;; Internal variables
- (defvar org-cite-basic--bibliography-cache nil
- "Cache for parsed bibliography files.
- This is an association list following the pattern:
- (FILE-ID . ENTRIES)
- FILE-ID is a cons cell (FILE . HASH), with FILE being the absolute file name of
- the bibliography file, and HASH a hash of its contents.
- ENTRIES is a hash table with citation references as keys and fields alist as
- values.")
- (defvar org-cite-basic--completion-cache (make-hash-table :test #'equal)
- "Cache for key completion table.
- This is an a hash-table.")
- ;;; Internal functions
- (defun org-cite-basic--parse-json ()
- "Parse JSON entries in the current buffer.
- Return a hash table with citation references as keys and fields alist as values."
- (let ((entries (make-hash-table :test #'equal)))
- (let ((json-array-type 'list)
- (json-key-type 'symbol))
- (dolist (item (json-read))
- (puthash (cdr (assq 'id item))
- (mapcar (pcase-lambda (`(,field . ,value))
- (pcase field
- ('author
- ;; Author is an array of objects, each
- ;; of them designing a person. These
- ;; objects may contain multiple
- ;; properties, but for this basic
- ;; processor, we'll focus on `given' and
- ;; `family'.
- ;;
- ;; For compatibility with BibTeX, add
- ;; "and" between authors.
- (cons 'author
- (mapconcat
- (lambda (alist)
- (concat (alist-get 'family alist)
- " "
- (alist-get 'given alist)))
- value
- " and ")))
- ('issued
- ;; Date are expressed as an array
- ;; (`date-parts') or a "string (`raw'
- ;; or `literal'). In both cases,
- ;; extract the year and associate it
- ;; to `year' field, for compatibility
- ;; with BibTeX format.
- (let ((date (or (alist-get 'date-parts value)
- (alist-get 'literal value)
- (alist-get 'raw value))))
- (cons 'year
- (cond
- ((consp date)
- (let ((year (caar date)))
- (cond
- ((numberp year) (number-to-string year))
- ((stringp year) year)
- (t
- (error
- "First element of CSL-JSON date-parts should be a number or string, got %s: %S"
- (type-of year) year)))))
- ((stringp date)
- (replace-regexp-in-string
- (rx
- (minimal-match (zero-or-more anything))
- (group-n 1 (repeat 4 digit))
- (zero-or-more anything))
- (rx (backref 1))
- date))
- (t
- (error "Unknown CSL-JSON date format: %S"
- value))))))
- (_
- (cons field value))))
- item)
- entries))
- entries)))
- (defun org-cite-basic--parse-bibtex (dialect)
- "Parse BibTeX entries in the current buffer.
- DIALECT is the BibTeX dialect used. See `bibtex-dialect'.
- Return a hash table with citation references as keys and fields alist as values."
- (let ((entries (make-hash-table :test #'equal))
- (bibtex-sort-ignore-string-entries t))
- (bibtex-set-dialect dialect t)
- ;; Throw an error if bibliography is malformed.
- (unless (bibtex-validate)
- (user-error "Malformed bibliography at %S"
- (or (buffer-file-name) (current-buffer))))
- (bibtex-map-entries
- (lambda (key &rest _)
- ;; Normalize entries: field names are turned into symbols
- ;; including special "=key=" and "=type=", and consecutive
- ;; white spaces are removed from values.
- (puthash key
- (mapcar
- (pcase-lambda (`(,field . ,value))
- (pcase field
- ("=key=" (cons 'id key))
- ("=type=" (cons 'type value))
- (_
- (cons
- (intern (downcase field))
- (replace-regexp-in-string "[ \t\n]+" " " value)))))
- ;; Parse, substituting the @string replacements.
- ;; See Emacs bug#56475 discussion.
- (let ((bibtex-string-files `(,(buffer-file-name)))
- (bibtex-expand-strings t))
- (bibtex-parse-entry t)))
- entries)))
- entries))
- (defvar org-cite-basic--file-id-cache nil
- "Hash table linking files to their hash.")
- (defun org-cite-basic--parse-bibliography (&optional info)
- "List all entries available in the buffer.
- Each association follows the pattern
- (FILE . ENTRIES)
- where FILE is the absolute file name of the BibTeX file, and ENTRIES is a hash
- table where keys are references and values are association lists between fields,
- as symbols, and values as strings or nil.
- Optional argument INFO is the export state, as a property list."
- (unless (hash-table-p org-cite-basic--file-id-cache)
- (setq org-cite-basic--file-id-cache (make-hash-table :test #'equal)))
- (if (plist-member info :cite-basic/bibliography)
- (plist-get info :cite-basic/bibliography)
- (let ((results nil))
- (dolist (file (org-cite-list-bibliography-files))
- (when (file-readable-p file)
- (with-temp-buffer
- (when (or (org-file-has-changed-p file)
- (not (gethash file org-cite-basic--file-id-cache)))
- (insert-file-contents file)
- (set-visited-file-name file t)
- (puthash file (org-buffer-hash) org-cite-basic--file-id-cache))
- (condition-case nil
- (unwind-protect
- (let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache)))
- (entries
- (or (cdr (assoc file-id org-cite-basic--bibliography-cache))
- (let ((table
- (pcase (file-name-extension file)
- ("json" (org-cite-basic--parse-json))
- ("bib" (org-cite-basic--parse-bibtex 'biblatex))
- ("bibtex" (org-cite-basic--parse-bibtex 'BibTeX))
- (ext
- (user-error "Unknown bibliography extension: %S"
- ext)))))
- (push (cons file-id table) org-cite-basic--bibliography-cache)
- table))))
- (push (cons file entries) results))
- (set-visited-file-name nil t))
- (error (setq org-cite-basic--file-id-cache nil))))))
- (when info (plist-put info :cite-basic/bibliography results))
- results)))
- (defun org-cite-basic--key-number (key info)
- "Return number associated to cited KEY.
- INFO is the export state, as a property list."
- (let ((predicate
- (org-cite-basic--field-less-p org-cite-basic-sorting-field info)))
- (org-cite-key-number key info predicate)))
- (defun org-cite-basic--all-keys ()
- "List all keys available in current bibliography."
- (seq-mapcat (pcase-lambda (`(,_ . ,entries))
- (map-keys entries))
- (org-cite-basic--parse-bibliography)))
- (defun org-cite-basic--get-entry (key &optional info)
- "Return BibTeX entry for KEY, as an association list.
- When non-nil, INFO is the export state, as a property list."
- (catch :found
- (pcase-dolist (`(,_ . ,entries) (org-cite-basic--parse-bibliography info))
- (let ((entry (gethash key entries)))
- (when entry (throw :found entry))))
- nil))
- (defun org-cite-basic--get-field (field entry-or-key &optional info raw)
- "Return FIELD value for ENTRY-OR-KEY, or nil.
- FIELD is a symbol. ENTRY-OR-KEY is either an association list, as returned by
- `org-cite-basic--get-entry', or a string representing a citation key.
- Optional argument INFO is the export state, as a property list.
- Return value may be nil or a string. If current export back-end is derived
- from `latex', return a raw string instead, unless optional argument RAW is
- non-nil."
- (let ((value
- (cdr
- (assq field
- (pcase entry-or-key
- ((pred stringp)
- (org-cite-basic--get-entry entry-or-key info))
- ((pred consp)
- entry-or-key)
- (_
- (error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key)))))))
- (if (and value
- (not raw)
- (org-export-derived-backend-p (plist-get info :back-end) 'latex))
- (org-export-raw-string value)
- value)))
- (defun org-cite-basic--shorten-names (names)
- "Return a list of family names from a list of full NAMES.
- To better accomomodate corporate names, this will only shorten
- personal names of the form \"family, given\"."
- (when (stringp names)
- (mapconcat
- (lambda (name)
- (if (eq 1 (length name))
- (cdr (split-string name))
- (car (split-string name ", "))))
- (split-string names " and ")
- ", ")))
- (defun org-cite-basic--number-to-suffix (n)
- "Compute suffix associated to number N.
- This is used for disambiguation."
- (let ((result nil))
- (apply #'string
- (mapcar (lambda (n) (+ 97 n))
- (catch :complete
- (while t
- (push (% n 26) result)
- (setq n (/ n 26))
- (cond
- ((= n 0) (throw :complete result))
- ((< n 27) (throw :complete (cons (1- n) result)))
- ((= n 27) (throw :complete (cons 0 (cons 0 result))))
- (t nil))))))))
- (defun org-cite-basic--get-author (entry-or-key &optional info raw)
- "Return author associated to ENTRY-OR-KEY.
- ENTRY-OR-KEY, INFO and RAW arguments are the same arguments as
- used in `org-cite-basic--get-field', which see.
- Author is obtained from the \"author\" field, if available, or
- from the \"editor\" field otherwise."
- (or (org-cite-basic--get-field 'author entry-or-key info raw)
- (org-cite-basic--get-field 'editor entry-or-key info raw)))
- (defun org-cite-basic--get-year (entry-or-key info &optional no-suffix)
- "Return year associated to ENTRY-OR-KEY.
- ENTRY-OR-KEY is either an association list, as returned by
- `org-cite-basic--get-entry', or a string representing a citation
- key. INFO is the export state, as a property list.
- Year is obtained from the \"year\" field, if available, or from
- the \"date\" field if it starts with a year pattern.
- Unlike `org-cite-basic--get-field', this function disambiguates
- author-year patterns by adding a letter suffix to the year when
- necessary, unless optional argument NO-SUFFIX is non-nil."
- ;; The cache is an association list with the following structure:
- ;;
- ;; (AUTHOR-YEAR . KEY-SUFFIX-ALIST).
- ;;
- ;; AUTHOR-YEAR is the author year pair associated to current entry
- ;; or key.
- ;;
- ;; KEY-SUFFIX-ALIST is an association (KEY . SUFFIX), where KEY is
- ;; the cite key, as a string, and SUFFIX is the generated suffix
- ;; string, or the empty string.
- (let* ((author (org-cite-basic--get-author entry-or-key info 'raw))
- (year
- (or (org-cite-basic--get-field 'year entry-or-key info 'raw)
- (let ((date
- (org-cite-basic--get-field 'date entry-or-key info t)))
- (and (stringp date)
- (string-match (rx string-start
- (group (= 4 digit))
- (or string-end (not digit)))
- date)
- (match-string 1 date)))))
- (cache-key (cons author year))
- (key
- (pcase entry-or-key
- ((pred stringp) entry-or-key)
- ((pred consp) (cdr (assq 'id entry-or-key)))
- (_ (error "Wrong value for ENTRY-OR-KEY: %S" entry-or-key))))
- (cache (plist-get info :cite-basic/author-date-cache)))
- (pcase (assoc cache-key cache)
- ('nil
- (let ((value (cons cache-key (list (cons key "")))))
- (plist-put info :cite-basic/author-date-cache (cons value cache))
- year))
- (`(,_ . ,alist)
- (let ((suffix
- (or (cdr (assoc key alist))
- (let ((new (org-cite-basic--number-to-suffix
- (1- (length alist)))))
- (push (cons key new) alist)
- new))))
- (if no-suffix year (concat year suffix)))))))
- (defun org-cite-basic--print-entry (entry style &optional info)
- "Format ENTRY according to STYLE string.
- ENTRY is an alist, as returned by `org-cite-basic--get-entry'.
- Optional argument INFO is the export state, as a property list."
- (let ((author (org-cite-basic--get-author entry info))
- (title (org-cite-basic--get-field 'title entry info))
- (from
- (or (org-cite-basic--get-field 'publisher entry info)
- (org-cite-basic--get-field 'journal entry info)
- (org-cite-basic--get-field 'institution entry info)
- (org-cite-basic--get-field 'school entry info))))
- (pcase style
- ("plain"
- (let ((year (org-cite-basic--get-year entry info 'no-suffix)))
- (org-cite-concat
- (org-cite-basic--shorten-names author) ". "
- title (and from (list ", " from)) ", " year ".")))
- ("numeric"
- (let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info))
- (year (org-cite-basic--get-year entry info 'no-suffix)))
- (org-cite-concat
- (format "[%d] " n) author ", "
- (org-cite-emphasize 'italic title)
- (and from (list ", " from)) ", "
- year ".")))
- ;; Default to author-year. Use year disambiguation there.
- (_
- (let ((year (org-cite-basic--get-year entry info)))
- (org-cite-concat
- author " (" year "). "
- (org-cite-emphasize 'italic title)
- (and from (list ", " from)) "."))))))
- ;;; "Activate" capability
- (defun org-cite-basic--close-keys (key keys)
- "List cite keys close to KEY in terms of string distance."
- (seq-filter (lambda (k)
- (>= org-cite-basic-max-key-distance
- (org-string-distance k key)))
- keys))
- (defun org-cite-basic--set-keymap (beg end suggestions)
- "Set keymap on citation key between BEG and END positions.
- When the key is know, SUGGESTIONS is nil. Otherwise, it may be
- a list of replacement keys, as strings, which will be offered as
- substitutes for the unknown key. Finally, it may be the symbol
- `all'."
- (let ((km (make-sparse-keymap)))
- (define-key km (kbd "<mouse-1>")
- (pcase suggestions
- ('nil #'org-open-at-point)
- ('all #'org-cite-insert)
- (_
- (lambda ()
- (interactive)
- (save-excursion
- (goto-char beg)
- (delete-region beg end)
- (insert
- "@"
- (if (= 1 (length suggestions))
- (car suggestions)
- (completing-read "Did you mean: "
- suggestions nil t))))))))
- (put-text-property beg end 'keymap km)))
- (defun org-cite-basic-activate (citation)
- "Set various text properties on CITATION object.
- Fontify whole citation with `org-cite' face. Fontify key with `error' face
- when it does not belong to known keys. Otherwise, use `org-cite-key' face.
- Moreover, when mouse is on a known key, display the corresponding bibliography.
- On a wrong key, suggest a list of possible keys, and offer to substitute one of
- them with a mouse click."
- (pcase-let ((`(,beg . ,end) (org-cite-boundaries citation))
- (keys (org-cite-basic--all-keys)))
- (put-text-property beg end 'font-lock-multiline t)
- (add-face-text-property beg end 'org-cite)
- (dolist (reference (org-cite-get-references citation))
- (pcase-let* ((`(,beg . ,end) (org-cite-key-boundaries reference))
- (key (org-element-property :key reference)))
- ;; Highlight key on mouse over.
- (put-text-property beg end
- 'mouse-face
- org-cite-basic-mouse-over-key-face)
- (if (member key keys)
- ;; Activate a correct key. Face is `org-cite-key' and
- ;; `help-echo' displays bibliography entry, for reference.
- ;; <mouse-1> calls `org-open-at-point'.
- (let* ((entry (org-cite-basic--get-entry key))
- (bibliography-entry
- (org-element-interpret-data
- (org-cite-basic--print-entry entry "plain"))))
- (add-face-text-property beg end 'org-cite-key)
- (put-text-property beg end 'help-echo bibliography-entry)
- (org-cite-basic--set-keymap beg end nil))
- ;; Activate a wrong key. Face is `error', `help-echo'
- ;; displays possible suggestions.
- (add-face-text-property beg end 'error)
- (let ((close-keys (org-cite-basic--close-keys key keys)))
- (when close-keys
- (put-text-property beg end 'help-echo
- (concat "Suggestions (mouse-1 to substitute): "
- (mapconcat #'identity close-keys " "))))
- ;; When the are close know keys, <mouse-1> provides
- ;; completion to fix the current one. Otherwise, call
- ;; `org-cite-insert'.
- (org-cite-basic--set-keymap beg end (or close-keys 'all))))))))
- ;;; "Export" capability
- (defun org-cite-basic--format-author-year (citation format-cite format-ref info)
- "Format CITATION object according to author-year format.
- FORMAT-CITE is a function of three arguments: the global prefix, the contents,
- and the global suffix. All arguments can be strings or secondary strings.
- FORMAT-REF is a function of four arguments: the reference prefix, as a string or
- secondary string, the author, the year, and the reference suffix, as a string or
- secondary string.
- INFO is the export state, as a property list."
- (org-export-data
- (funcall format-cite
- (org-element-property :prefix citation)
- (org-cite-mapconcat
- (lambda (ref)
- (let ((k (org-element-property :key ref))
- (prefix (org-element-property :prefix ref))
- (suffix (org-element-property :suffix ref)))
- (funcall format-ref
- prefix
- (org-cite-basic--get-author k info)
- (org-cite-basic--get-year k info)
- suffix)))
- (org-cite-get-references citation)
- org-cite-basic-author-year-separator)
- (org-element-property :suffix citation))
- info))
- (defun org-cite-basic--citation-numbers (citation info)
- "Return numbers associated to references in CITATION object.
- INFO is the export state as a property list."
- (let* ((numbers
- (sort (mapcar (lambda (k) (org-cite-basic--key-number k info))
- (org-cite-get-references citation t))
- #'<))
- (last (car numbers))
- (result (list (number-to-string (pop numbers)))))
- ;; Use compact number references, i.e., "1, 2, 3" becomes "1-3".
- (while numbers
- (let ((current (pop numbers))
- (next (car numbers)))
- (cond
- ((and next
- (= current (1+ last))
- (= current (1- next)))
- (unless (equal "-" (car result))
- (push "-" result)))
- ((equal "-" (car result))
- (push (number-to-string current) result))
- (t
- (push (format ", %d" current) result)))
- (setq last current)))
- (apply #'concat (nreverse result))))
- (defun org-cite-basic--field-less-p (field info)
- "Return a sort predicate comparing FIELD values for two citation keys.
- INFO is the export state, as a property list."
- (and field
- (lambda (a b)
- (string-collate-lessp
- (org-cite-basic--get-field field a info 'raw)
- (org-cite-basic--get-field field b info 'raw)
- nil t))))
- (defun org-cite-basic--sort-keys (keys info)
- "Sort KEYS by author name.
- INFO is the export communication channel, as a property list."
- (let ((predicate (org-cite-basic--field-less-p org-cite-basic-sorting-field info)))
- (if predicate
- (sort keys predicate)
- keys)))
- (defun org-cite-basic-export-citation (citation style _ info)
- "Export CITATION object.
- STYLE is the expected citation style, as a pair of strings or nil. INFO is the
- export communication channel, as a property list."
- (let ((has-variant-p
- (lambda (variant type)
- ;; Non-nil when style VARIANT has TYPE. TYPE is either
- ;; `bare' or `caps'.
- (member variant
- (pcase type
- ('bare '("bare" "bare-caps" "b" "bc"))
- ('caps '("caps" "bare-caps" "c" "bc"))
- (_ (error "Invalid variant type: %S" type)))))))
- (pcase style
- ;; "author" style.
- (`(,(or "author" "a") . ,variant)
- (let ((caps (member variant '("caps" "c"))))
- (org-export-data
- (mapconcat
- (lambda (key)
- (let ((author (org-cite-basic--get-author key info)))
- (if caps (capitalize author) author)))
- (org-cite-get-references citation t)
- org-cite-basic-author-year-separator)
- info)))
- ;; "noauthor" style.
- (`(,(or "noauthor" "na") . ,variant)
- (format (if (funcall has-variant-p variant 'bare) "%s" "(%s)")
- (mapconcat (lambda (key) (org-cite-basic--get-year key info))
- (org-cite-get-references citation t)
- org-cite-basic-author-year-separator)))
- ;; "nocite" style.
- (`(,(or "nocite" "n") . ,_) nil)
- ;; "text" and "note" styles.
- (`(,(and (or "text" "note" "t" "ft") style) . ,variant)
- (when (and (member style '("note" "ft"))
- (not (org-cite-inside-footnote-p citation)))
- (org-cite-adjust-note citation info)
- (org-cite-wrap-citation citation info))
- (let ((bare (funcall has-variant-p variant 'bare))
- (caps (funcall has-variant-p variant 'caps)))
- (org-cite-basic--format-author-year
- citation
- (lambda (p c s) (org-cite-concat p c s))
- (lambda (p a y s)
- (org-cite-concat p
- (if caps (capitalize a) a)
- (if bare " " " (")
- y s
- (and (not bare) ")")))
- info)))
- ;; "numeric" style.
- ;;
- ;; When using this style on citations with multiple references,
- ;; use global affixes and ignore local ones.
- (`(,(or "numeric" "nb") . ,_)
- (pcase-let ((`(,prefix . ,suffix) (org-cite-main-affixes citation)))
- (org-export-data
- (org-cite-concat
- "(" prefix (org-cite-basic--citation-numbers citation info) suffix ")")
- info)))
- ;; Default ("nil") style.
- (`(,_ . ,variant)
- (let ((bare (funcall has-variant-p variant 'bare))
- (caps (funcall has-variant-p variant 'caps)))
- (org-cite-basic--format-author-year
- citation
- (lambda (p c s)
- (org-cite-concat (and (not bare) "(") p c s (and (not bare) ")")))
- (lambda (p a y s)
- (org-cite-concat p (if caps (capitalize a) a) ", " y s))
- info)))
- ;; This should not happen.
- (_ (error "Invalid style: %S" style)))))
- (defun org-cite-basic-export-bibliography (keys _files style _props backend info)
- "Generate bibliography.
- KEYS is the list of cited keys, as strings. STYLE is the expected bibliography
- style, as a string. BACKEND is the export back-end, as a symbol. INFO is the
- export state, as a property list."
- (mapconcat
- (lambda (k)
- (let ((entry (org-cite-basic--get-entry k info)))
- (org-export-data
- (org-cite-make-paragraph
- (and (org-export-derived-backend-p backend 'latex)
- (org-export-raw-string "\\noindent\n"))
- (org-cite-basic--print-entry entry style info))
- info)))
- (org-cite-basic--sort-keys keys info)
- "\n"))
- ;;; "Follow" capability
- (defun org-cite-basic-goto (datum _)
- "Follow citation or citation reference DATUM.
- When DATUM is a citation reference, open bibliography entry referencing
- the citation key. Otherwise, select which key to follow among all keys
- present in the citation."
- (let* ((key
- (if (eq 'citation-reference (org-element-type datum))
- (org-element-property :key datum)
- (pcase (org-cite-get-references datum t)
- (`(,key) key)
- (keys
- (or (completing-read "Select citation key: " keys nil t)
- (user-error "Aborted"))))))
- (file
- (pcase (seq-find (pcase-lambda (`(,_ . ,entries))
- (gethash key entries))
- (org-cite-basic--parse-bibliography))
- (`(,f . ,_) f)
- (_ (user-error "Cannot find citation key: %S" key)))))
- (org-open-file file '(4))
- (pcase (file-name-extension file)
- ("json"
- ;; `rx' can not be used with Emacs <27.1 since `literal' form
- ;; is not supported.
- (let ((regexp (rx-to-string `(seq "\"id\":" (0+ (any "[ \t]")) "\"" ,key "\"") t)))
- (goto-char (point-min))
- (re-search-forward regexp)
- (search-backward "{")))
- (_
- (bibtex-set-dialect)
- (bibtex-search-entry key)))))
- ;;; "Insert" capability
- (defun org-cite-basic--complete-style (_)
- "Offer completion for style.
- Return chosen style as a string."
- (let* ((styles
- (mapcar (pcase-lambda (`((,style . ,_) . ,_))
- style)
- (org-cite-supported-styles))))
- (pcase styles
- (`(,style) style)
- (_ (completing-read "Style (\"\" for default): " styles nil t)))))
- (defun org-cite-basic--key-completion-table ()
- "Return completion table for cite keys, as a hash table.
- In this hash table, keys are a strings with author, date, and
- title of the reference. Values are the cite keys.
- Return nil if there are no bibliography files or no entries."
- ;; Populate bibliography cache.
- (let ((entries (org-cite-basic--parse-bibliography)))
- (cond
- ((null entries) nil) ;no bibliography files
- ((gethash entries org-cite-basic--completion-cache)
- org-cite-basic--completion-cache)
- (t
- (clrhash org-cite-basic--completion-cache)
- (dolist (key (org-cite-basic--all-keys))
- (let* ((entry (org-cite-basic--get-entry
- key
- ;; Supply pre-calculated bibliography to avoid
- ;; performance degradation.
- (list :cite-basic/bibliography entries)))
- (completion
- (concat
- (let ((author (org-cite-basic--get-author entry nil 'raw)))
- (if author
- (truncate-string-to-width
- (replace-regexp-in-string " and " "; " author)
- org-cite-basic-author-column-end nil ?\s)
- (make-string org-cite-basic-author-column-end ?\s)))
- org-cite-basic-column-separator
- (let ((date (org-cite-basic--get-year entry nil 'no-suffix)))
- (format "%4s" (or date "")))
- org-cite-basic-column-separator
- (org-cite-basic--get-field 'title entry nil t))))
- (puthash completion key org-cite-basic--completion-cache)))
- (unless (map-empty-p org-cite-basic--completion-cache) ;no key
- (puthash entries t org-cite-basic--completion-cache)
- org-cite-basic--completion-cache)))))
- (defun org-cite-basic--complete-key (&optional multiple)
- "Prompt for a reference key and return a citation reference string.
- When optional argument MULTIPLE is non-nil, prompt for multiple
- keys, until one of them is nil. Then return the list of
- reference strings selected.
- Raise an error when no bibliography is set in the buffer."
- (let* ((table
- (or (org-cite-basic--key-completion-table)
- (user-error "No bibliography set")))
- (prompt
- (lambda (text)
- (completing-read text table nil t))))
- (if (null multiple)
- (let ((key (gethash (funcall prompt "Key: ") table)))
- (org-string-nw-p key))
- (let* ((keys nil)
- (build-prompt
- (lambda ()
- (if keys
- (format "Key (empty input exits) %s: "
- (mapconcat #'identity (reverse keys) ";"))
- "Key (empty input exits): "))))
- (let ((key (funcall prompt (funcall build-prompt))))
- (while (org-string-nw-p key)
- (push (gethash key table) keys)
- (setq key (funcall prompt (funcall build-prompt)))))
- keys))))
- ;;; Register processor
- (org-cite-register-processor 'basic
- :activate #'org-cite-basic-activate
- :export-citation #'org-cite-basic-export-citation
- :export-bibliography #'org-cite-basic-export-bibliography
- :follow #'org-cite-basic-goto
- :insert (org-cite-make-insert-processor #'org-cite-basic--complete-key
- #'org-cite-basic--complete-style)
- :cite-styles
- '((("author" "a") ("caps" "c"))
- (("noauthor" "na") ("bare" "b"))
- (("nocite" "n"))
- (("note" "ft") ("bare-caps" "bc") ("caps" "c"))
- (("numeric" "nb"))
- (("text" "t") ("bare-caps" "bc") ("caps" "c"))
- (("nil") ("bare" "b") ("bare-caps" "bc") ("caps" "c"))))
- (provide 'oc-basic)
- ;;; oc-basic.el ends here
|