emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/org 4415635 06/14: oc-basic: Implement `basic' citation


From: ELPA Syncer
Subject: [elpa] externals/org 4415635 06/14: oc-basic: Implement `basic' citation processor
Date: Fri, 9 Jul 2021 02:57:17 -0400 (EDT)

branch: externals/org
commit 44156353c939bbe01d43e814744eae42fc282e56
Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Commit: Nicolas Goaziou <mail@nicolasgoaziou.fr>

    oc-basic: Implement `basic' citation processor
    
    * lisp/oc-basic.el: New file.
---
 lisp/oc-basic.el | 752 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 752 insertions(+)

diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
new file mode 100644
index 0000000..4e9d2e5
--- /dev/null
+++ b/lisp/oc-basic.el
@@ -0,0 +1,752 @@
+;;; oc-basic.el --- basic back-end for citations  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+
+;; This program 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.
+
+;; This program 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 this program.  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 'bibtex)
+(require 'oc)
+
+(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 t)
+
+(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 t)
+
+(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 t)
+
+(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 t)
+
+(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 t)
+
+(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 t)
+
+
+;;; 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').
+                              ;; 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 'raw value))))
+                                (cons 'year
+                                      (cond
+                                       ((consp date)
+                                        (caar date))
+                                       ((stringp date)
+                                        (car (split-string date "-")))
+                                       (t
+                                        (error "Unknown CSL-JSON date format: 
%S"
+                                               date))))))
+                             (_
+                              (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)
+    (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)))))
+                 (bibtex-parse-entry t))
+                entries)))
+    entries))
+
+(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."
+  (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
+            (insert-file-contents file)
+           (let* ((file-id (cons file (buffer-hash)))
+                   (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)))))
+      (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--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-year (entry-or-key info)
+  "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.
+
+Unlike `org-cite-basic--get-field', this function disambiguates author-year
+patterns."
+  ;; 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-field 'author entry-or-key info 'raw))
+         (year (org-cite-basic--get-field 'year entry-or-key info 'raw))
+         (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)
+       (concat year
+               (or (cdr (assoc key alist))
+                   (let ((new (org-cite-basic--number-to-suffix (1- (length 
alist)))))
+                     (push (cons key new) alist)
+                     new)))))))
+
+(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-field 'author entry info))
+        (title (org-cite-basic--get-field 'title entry info))
+        (year (org-cite-basic--get-field 'year 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"
+       (org-cite-concat
+        author ". " title (and from (list ", " from)) ", " year "."))
+      ("numeric"
+       (let ((n (org-cite-basic--key-number (cdr (assq 'id entry)) info)))
+         (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--make-repair-keymap (beg end suggestions)
+  "Return keymap active on wrong citation keys.
+BEG and END are boundaries of the wrong citation.  SUGGESTIONS is a list of
+replacement keys, as strings."
+  (let ((km (make-sparse-keymap))
+        (f (lambda ()
+             (interactive)
+             (setf (buffer-substring beg end)
+                   (concat "@"
+                           (if (= 1 (length suggestions))
+                               (car suggestions)
+                             (completing-read "Substitute key: "
+                                              suggestions nil t)))))))
+    (define-key km (kbd "<mouse-1>") f)
+    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.
+            (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))
+          ;; Activate a wrong key.  Face is `error', `help-echo'
+          ;; displays possible suggestions, and <mouse-1> provides
+          ;; completion to fix the key.
+          (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 " 
")))
+              (put-text-property beg end 'keymap
+                                 (org-cite-basic--make-repair-keymap
+                                  beg end close-keys)))))))))
+
+
+;;; "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-field '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)
+         (org-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-field '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") . ,_)
+       (let* ((references (org-cite-get-references citation))
+              (prefix
+               (or (org-element-property :prefix citation)
+                   (and (= 1 (length references))
+                        (org-element-property :prefix (car references)))))
+              (suffix
+               (or (org-element-property :suffix citation)
+                   (and (= 1 (length references))
+                        (org-element-property :suffix (car references))))))
+         (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))
+    (if (not (equal "json" (file-name-extension file)))
+        (bibtex-search-entry key)
+      (let ((regexp (rx "\"id\":" (0+ (any "[ \t]")) "\"" (literal key) "\"")))
+        (goto-char (point-min))
+        (re-search-forward regexp)
+        (search-backward "{")))))
+
+
+;;; "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 key."
+  (let ((cache-key (mapcar #'car org-cite-basic--bibliography-cache)))
+    (if (gethash cache-key org-cite-basic--completion-cache)
+        org-cite-basic--completion-cache
+      (clrhash org-cite-basic--completion-cache)
+      (dolist (key (org-cite-basic--all-keys))
+        (let ((completion
+               (concat
+                (let ((author (org-cite-basic--get-field 'author key nil t)))
+                  (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-field 'year key nil t)))
+                  (format "%4s" (or date "")))
+                org-cite-basic-column-separator
+                (org-cite-basic--get-field 'title key nil t))))
+          (puthash completion key org-cite-basic--completion-cache)))
+      (puthash cache-key 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 (\"\" to exit) %s: "
+                            (mapconcat #'identity (reverse keys) ";"))
+                  "Key (\"\" to exit): "))))
+        (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 'org-cite-basic)
+(provide 'oc-basic)
+;;; oc-default.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]