forked from mirrors/org-mode
937 lines
38 KiB
EmacsLisp
937 lines
38 KiB
EmacsLisp
;;; oc-basic.el --- basic backend for citations -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2021-2024 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-create "org-element-ast" (type &optional props &rest children))
|
||
(declare-function org-element-set "org-element-ast" (old new &optional keep-props))
|
||
|
||
(declare-function org-element-interpret-data "org-element" (data))
|
||
(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
|
||
(declare-function org-element-map "org-element"
|
||
( data types fun
|
||
&optional
|
||
info first-match no-recursion
|
||
with-affiliated no-undefer))
|
||
(declare-function org-element-property "org-element-ast" (property node))
|
||
(declare-function org-element-type-p "org-element-ast" (node types))
|
||
(declare-function org-element-contents "org-element-ast" (node))
|
||
|
||
(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
|
||
((or 'author 'editor)
|
||
;; Author and editors are arrays 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 and editors.
|
||
(cons field
|
||
(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))
|
||
;; Follow symlinks, to look into modification time of the
|
||
;; actual file, not its symlink.
|
||
(setq file (file-truename file))
|
||
(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 backend is derived
|
||
from `latex', return a raw string object instead, unless optional
|
||
argument RAW is non-nil.
|
||
|
||
Throw an error if the field value is non-string and 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)))))))
|
||
(when (and value (not (stringp value)))
|
||
(error "Non-string bibliography field value: %S" value))
|
||
(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.
|
||
NAMES can be a string or raw string object.
|
||
|
||
To better accomomodate corporate names, this will only shorten
|
||
personal names of the form \"family, given\"."
|
||
(let (names-string raw-p)
|
||
(cond
|
||
((stringp names) (setq names-string names))
|
||
((org-element-type-p names 'raw)
|
||
(setq names-string (mapconcat #'identity (org-element-contents names) "")
|
||
raw-p t)))
|
||
(when names-string
|
||
(setq names-string
|
||
(mapconcat
|
||
(lambda (name)
|
||
(if (eq 1 (length name))
|
||
(cdr (split-string name))
|
||
(car (split-string name ", "))))
|
||
(split-string names-string " and ")
|
||
", "))
|
||
(if raw-p (org-export-raw-string names-string)
|
||
names-string))))
|
||
|
||
(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 'raw)))
|
||
(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-bibtex-string (element &optional info)
|
||
"Print Bibtex formatted string ELEMENT, according to Bibtex syntax.
|
||
Remove all the {...} that are not a part of LaTeX macros and parse the
|
||
LaTeX fragments. Do nothing when current backend is derived from
|
||
LaTeX, according to INFO.
|
||
|
||
Return updated ELEMENT."
|
||
(if (org-export-derived-backend-p (plist-get info :back-end) 'latex)
|
||
;; Derived from LaTeX, no need to use manual ad-hoc LaTeX
|
||
;; parser.
|
||
element
|
||
;; Convert ELEMENT to anonymous when ELEMENT is string.
|
||
;; Otherwise, we cannot modify ELEMENT by side effect.
|
||
(when (org-element-type-p element 'plain-text)
|
||
(setq element (org-element-create 'anonymous nil element)))
|
||
;; Approximately parse LaTeX fragments, assuming Org mode syntax
|
||
;; (it is close to original LaTeX, and we do not want to
|
||
;; re-implement complete LaTeX parser here))
|
||
(org-element-map element t
|
||
(lambda (str)
|
||
(when (stringp str)
|
||
(org-element-set
|
||
str
|
||
(org-element-parse-secondary-string
|
||
str '(latex-fragment entity))))))
|
||
;; Strip the remaining { and }.
|
||
(org-element-map element t
|
||
(lambda (str)
|
||
(when (stringp str)
|
||
(org-element-set str (replace-regexp-in-string "[{}]" "" str)))))
|
||
element))
|
||
|
||
(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))))
|
||
(org-cite-basic--print-bibtex-string
|
||
(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)) "."))))
|
||
info)))
|
||
|
||
|
||
;;; "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
|
||
(or (org-cite-basic--get-author k info) "??")
|
||
(or (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-cite-basic--format-author-year
|
||
citation
|
||
(lambda (p c s) (org-cite-concat p c s))
|
||
(lambda (prefix author _ suffix)
|
||
(org-cite-concat
|
||
prefix
|
||
(if caps (org-cite-capitalize author) author)
|
||
suffix))
|
||
info)))
|
||
;; "noauthor" style.
|
||
(`(,(or "noauthor" "na") . ,variant)
|
||
(let ((bare? (funcall has-variant-p variant 'bare)))
|
||
(org-cite-basic--format-author-year
|
||
citation
|
||
(lambda (prefix contents suffix)
|
||
(org-cite-concat
|
||
(unless bare? "(")
|
||
prefix
|
||
contents
|
||
suffix
|
||
(unless bare? ")")))
|
||
(lambda (prefix _ year suffix)
|
||
(org-cite-concat prefix year suffix))
|
||
info)))
|
||
;; "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 (org-cite-capitalize a) a)
|
||
(if bare " " " (")
|
||
y
|
||
(and (not bare) ")")
|
||
s))
|
||
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 (org-cite-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 backend, as a symbol. INFO is the
|
||
export state, as a property list."
|
||
(mapconcat
|
||
(lambda (entry)
|
||
(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))
|
||
(delq nil
|
||
(mapcar
|
||
(lambda (k) (org-cite-basic--get-entry k 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 (org-element-type-p datum 'citation-reference)
|
||
(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 'raw))))
|
||
(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
|