add missing libs and update settings to new versions

2022-01-05 10:56:16 +01:00
parent c781a5becb
commit 5068bab121
34 changed files with 7215 additions and 124 deletions
--- a/lisp/citeproc/citeproc-proc.el
+++ b/lisp/citeproc/citeproc-proc.el
@@ -0,0 +1,224 @@
+;;; citeproc-proc.el --- construct and manage citation processors -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 András Simonyi
+
+;; Author: András Simonyi <andras.simonyi@gmail.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;; This file is not part of GNU Emacs.
+
+;;; Commentary:
+
+;; Structure type and functions to construct citation processor objects, add or
+;; clear stored bibliography items, and disambiguate and finalize the rendering
+;; of the stored items.
+
+;;; Code:
+
+(require 'subr-x)
+(require 'dash)
+(require 'cl-lib)
+(require 'queue)
+(require 's)
+
+(require 'citeproc-date)
+(require 'citeproc-itemdata)
+(require 'citeproc-disamb)
+
+(cl-defstruct (citeproc-proc (:constructor citeproc-proc--create))
+  "Citation processor struct.
+STYLE is a `citeproc-style' struct,
+GETTER is a bibliography item getter,
+ITEMDATA is a hash table that maps itemids to `citeproc-itemdata'
+  structs,
+CITATIONS is a queue containing citations,
+NAMES is hash table that maps name alists to ids,
+FINALIZED is non-nil iff the processor is finalized
+  (bibliography items are properly sorted, citation positions are
+  updated etc),
+UNCITED is a list of lists of uncited itemids to be added during
+  finalization,
+BIB-FILTERS is a list of filters defining sub-bibliographies."
+  style getter itemdata citations names finalized uncited bib-filters)
+
+(defun citeproc-proc--internalize-name (name proc)
+  "Find or add name-alist NAME in/to the names stored in PROC.
+Return an internalized version which contains the name-id, and is
+sorted."
+  (let* ((sorted (sort name (lambda (x y)
+			      (string< (car x) (car y)))))
+	 (names (citeproc-proc-names proc))
+	 (val (gethash sorted names)))
+    (cons (cons 'name-id
+		(or val (puthash sorted (hash-table-count names) names)))
+	  sorted)))
+
+(defconst citeproc-proc--nonstd-csl-vars-alist
+  '((shortTitle . title-short) (journalAbbreviation . container-title-short))
+  "Alist mapping non-standard citeproc.js vars to their standard CSL peers.")
+
+(defun citeproc-proc--internalize-item (proc item)
+  "Return the internal form of a CSL json ITEM for PROC."
+  (let* (label
+	 page-first
+	 (result
+	  (--map
+	   (let* ((orig-var (car it))
+		  (var (-if-let (mapped (alist-get orig-var
+						   citeproc-proc--nonstd-csl-vars-alist))
+			   mapped
+			 orig-var))
+		  (value (citeproc-proc--parse-csl-var-val (cdr it) var proc)))
+	     (pcase var
+	       ('page (-when-let (page-first-match (s-match "[[:digit:]]+" value))
+			(setq page-first (car page-first-match))))
+	       ('label (setq label t)))
+	     (cons var value))
+	   item)))
+    (when page-first (push (cons 'page-first page-first) result))
+    (unless label (push (cons 'label "page") result))
+    ;; Generate the editor-translator variable if needed
+    ;; (required by CSL 1.02)
+    (when-let* (((null (alist-get 'editor-translator result)))
+		(editor (alist-get 'editor result))
+		(translator (alist-get 'translator result))
+		((string= (alist-get 'name-id editor)
+			  (alist-get 'name-id translator))))
+      (push (cons 'editor-translator editor) result))
+    result))
+
+(defun citeproc-proc--put-item (proc item itemid)
+  "Put parsed csl-json ITEM with ITEMID into PROC.
+Return the added itemdata structure."
+  (let* ((int-vars (citeproc-proc--internalize-item proc item))
+	 (itemdata (citeproc-itemdata-create :varvals int-vars :rc-uptodate nil)))
+    (citeproc-proc-put-itd-put itemid itemdata proc)
+    (citeproc-itd-setvar itemdata 'citation-number
+			 (number-to-string (hash-table-count
+					    (citeproc-proc-itemdata proc))))
+    (setf (citeproc-proc-finalized proc) nil)
+    itemdata))
+
+(defun citeproc-proc-put-item-by-id (proc itemid)
+  "Put item with ITEMID into the itemlist of PROC.
+Return the itemdata struct that was added."
+  (let ((item (cdar (funcall (citeproc-proc-getter proc)
+			     (list itemid)))))
+    (citeproc-proc--put-item proc
+			     (or item `((unprocessed-with-id . ,itemid)))
+			     itemid)))
+
+(defun citeproc-proc-put-items-by-id (proc itemids)
+  "Add items with ITEMIDS into the itemlist of PROC."
+  (let* ((received (funcall (citeproc-proc-getter proc) itemids))
+	 ;; OPTIMIZE: putting the received items into the original order could/should be
+	 ;; made more efficient
+	 (items (--map (cons it (assoc-default it received))
+		       itemids)))
+    (cl-loop for (itemid . item) in items do
+	     (citeproc-proc--put-item proc
+				      (or item `((unprocessed-with-id . ,itemid)))
+				      itemid))))
+
+(defun citeproc-proc-put-itd-put (id data proc)
+  "Put the DATA of item with ID in processor PROC."
+  (let ((itemdata (citeproc-proc-itemdata proc)))
+    (puthash id data itemdata)))
+
+(defun citeproc-proc-process-uncited (proc)
+  "Add uncited items to the itemdata in PROC."
+  (when-let ((unciteds (citeproc-proc-uncited proc)))
+   (let* ((itemids (cl-delete-duplicates (apply #'append unciteds))))
+     (when (member "*" itemids)
+       (setq itemids (funcall (citeproc-proc-getter proc) 'itemids)))
+     (let* ((itemdata (citeproc-proc-itemdata proc))
+	    (new-ids (--remove (gethash it itemdata) itemids))
+	    (id-items (funcall (citeproc-proc-getter proc) new-ids)))
+       (pcase-dolist (`(,id . ,item) id-items)
+	 (citeproc-proc--put-item
+	  proc
+	  (or item `((unprocessed-with-id . ,id)))
+	  id))))))
+
+(defun citeproc-proc-delete-occurrence-info (proc)
+  "Remove all itemdata occurrence info from PROC."
+  (maphash (lambda (_ itd)
+	     (setf (citeproc-itemdata-occurred-before itd) nil))
+	   (citeproc-proc-itemdata proc)))
+
+(defun citeproc-proc--parse-csl-var-val (rep var proc)
+  "Parse the json representation REP of csl variable VAR.
+VAR is a csl variable as symbol;
+REP is its value in standard csl json representation as parsed by
+  the Emacs `json' library;
+PROC is the target citeproc-processor of the internal representation.
+Return the PROC-internal representation of REP."
+  (cond ((memq var citeproc--name-vars)
+	 (--map
+	  (let* ((filtered (-remove (lambda (x) (eq (car x) 'isInstitution)) it))
+		 (w-smart-aposts (--map (cons
+					 (car it)
+					 (let ((text-field (cdr it)))
+					   (if (stringp text-field)
+					       (citeproc-s-smart-apostrophes text-field)
+					     text-field)))
+					filtered)))
+	    (citeproc-proc--internalize-name w-smart-aposts proc))
+	  rep))
+	((memq var citeproc--date-vars)
+	 (citeproc-date-parse rep))
+	;;FIXME: We handle here the id... do we need it in the itemdata at all?
+	((or (memq var citeproc--number-vars) (eq 'id var))
+	 (citeproc-s-from-num-or-s rep))
+	((stringp rep)
+	 (let* ((w-aposts (citeproc-s-smart-apostrophes rep))
+		(rt (citeproc-rt-from-str w-aposts)))
+	   (if (s-contains-p "\"" rep)
+	       (let* ((terms (citeproc-style-terms (citeproc-proc-style proc)))
+		      (oq (citeproc-term-text-from-terms "open-quote" terms))
+		      (cq (citeproc-term-text-from-terms "close-quote" terms)))
+		 (citeproc-rt-change-case
+		  rt (lambda (x) (citeproc-s-smart-quotes x oq cq))))
+	     rt)))
+	(t rep)))
+
+(defun citeproc-proc-disamb (proc)
+  "Disambiguate the items stored in PROC."
+  (let* ((cite-opts (citeproc-style-cite-opts (citeproc-proc-style proc)))
+	 (name (string= "true" (alist-get 'disambiguate-add-names cite-opts)))
+	 (given (string= "true" (alist-get 'disambiguate-add-givenname cite-opts)))
+	 (yearsuff (string= "true" (alist-get 'disambiguate-add-year-suffix cite-opts))))
+    (citeproc-disamb-itds (hash-table-values (citeproc-proc-itemdata proc))
+			  (citeproc-proc-style proc)
+			  name given yearsuff)))
+
+(defun citeproc-proc-byte-compile (proc)
+  "Byte-compile all lambdas in PROC."
+  (let* ((style (citeproc-proc-style proc))
+	 (bib-sort (citeproc-style-bib-sort style))
+	 (cite-sort (citeproc-style-cite-sort style)))
+    (setf (citeproc-style-macros style)
+	  (--map (cons (car it) (byte-compile (cdr it)))
+		 (citeproc-style-macros style))
+	  (citeproc-style-cite-layout style)
+	  (byte-compile (citeproc-style-cite-layout style))
+	  (citeproc-style-bib-layout style)
+	  (byte-compile (citeproc-style-bib-layout style)))
+    (when bib-sort (setf (citeproc-style-bib-sort style) (byte-compile bib-sort)))
+    (when cite-sort (setf (citeproc-style-cite-sort style) (byte-compile cite-sort)))))
+
+(provide 'citeproc-proc)
+
+;;; citeproc-proc.el ends here