From: Andreas Gerler Date: Sat, 21 Dec 2024 16:26:00 +0000 (+0100) Subject: updaet citeproc X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=c36cb7452520e4aa2daaaa29f3411d2cb20452cf;p=emacsconfig.git updaet citeproc Signed-off-by: Andreas Gerler --- diff --git a/elpa/citeproc-20230228.1414/citeproc-autoloads.el b/elpa/citeproc-20230228.1414/citeproc-autoloads.el deleted file mode 100644 index e34bfe76..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-autoloads.el +++ /dev/null @@ -1,217 +0,0 @@ -;;; citeproc-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "citeproc" "citeproc.el" (0 0 0 0)) -;;; Generated autoloads from citeproc.el - -(register-definition-prefixes "citeproc" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-biblatex" "citeproc-biblatex.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from citeproc-biblatex.el - -(register-definition-prefixes "citeproc-biblatex" '("citeproc-blt-")) - -;;;*** - -;;;### (autoloads nil "citeproc-bibtex" "citeproc-bibtex.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from citeproc-bibtex.el - -(register-definition-prefixes "citeproc-bibtex" '("citeproc-bt-")) - -;;;*** - -;;;### (autoloads nil "citeproc-choose" "citeproc-choose.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from citeproc-choose.el - -(register-definition-prefixes "citeproc-choose" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-cite" "citeproc-cite.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-cite.el - -(register-definition-prefixes "citeproc-cite" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-context" "citeproc-context.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from citeproc-context.el - -(register-definition-prefixes "citeproc-context" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-date" "citeproc-date.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-date.el - -(register-definition-prefixes "citeproc-date" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-disamb" "citeproc-disamb.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from citeproc-disamb.el - -(register-definition-prefixes "citeproc-disamb" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-formatters" "citeproc-formatters.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from citeproc-formatters.el - -(register-definition-prefixes "citeproc-formatters" '("citeproc-f")) - -;;;*** - -;;;### (autoloads nil "citeproc-generic-elements" "citeproc-generic-elements.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from citeproc-generic-elements.el - -(register-definition-prefixes "citeproc-generic-elements" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-itemdata" "citeproc-itemdata.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from citeproc-itemdata.el - -(register-definition-prefixes "citeproc-itemdata" '("citeproc-itd-")) - -;;;*** - -;;;### (autoloads nil "citeproc-itemgetters" "citeproc-itemgetters.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from citeproc-itemgetters.el - -(register-definition-prefixes "citeproc-itemgetters" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-lib" "citeproc-lib.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-lib.el - -(register-definition-prefixes "citeproc-lib" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-locale" "citeproc-locale.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from citeproc-locale.el - -(register-definition-prefixes "citeproc-locale" '("citeproc-locale-")) - -;;;*** - -;;;### (autoloads nil "citeproc-macro" "citeproc-macro.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from citeproc-macro.el - -(register-definition-prefixes "citeproc-macro" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-name" "citeproc-name.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-name.el - -(register-definition-prefixes "citeproc-name" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-number" "citeproc-number.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from citeproc-number.el - -(register-definition-prefixes "citeproc-number" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-prange" "citeproc-prange.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from citeproc-prange.el - -(register-definition-prefixes "citeproc-prange" '("citeproc-prange-")) - -;;;*** - -;;;### (autoloads nil "citeproc-proc" "citeproc-proc.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-proc.el - -(register-definition-prefixes "citeproc-proc" '("citeproc-proc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-rt" "citeproc-rt.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-rt.el - -(register-definition-prefixes "citeproc-rt" '("citeproc-rt-")) - -;;;*** - -;;;### (autoloads nil "citeproc-s" "citeproc-s.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-s.el - -(register-definition-prefixes "citeproc-s" '("citeproc-s-")) - -;;;*** - -;;;### (autoloads nil "citeproc-sort" "citeproc-sort.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-sort.el - -(register-definition-prefixes "citeproc-sort" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-style" "citeproc-style.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from citeproc-style.el - -(register-definition-prefixes "citeproc-style" '("citeproc-")) - -;;;*** - -;;;### (autoloads nil "citeproc-subbibs" "citeproc-subbibs.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from citeproc-subbibs.el - -(register-definition-prefixes "citeproc-subbibs" '("citeproc-sb-")) - -;;;*** - -;;;### (autoloads nil "citeproc-term" "citeproc-term.el" (0 0 0 0)) -;;; Generated autoloads from citeproc-term.el - -(register-definition-prefixes "citeproc-term" '("citeproc-term-")) - -;;;*** - -;;;### (autoloads nil "citeproc-test-human" "citeproc-test-human.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from citeproc-test-human.el - -(register-definition-prefixes "citeproc-test-human" '("citeproc-test-human-")) - -;;;*** - -;;;### (autoloads nil nil ("citeproc-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; citeproc-autoloads.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-biblatex.el b/elpa/citeproc-20230228.1414/citeproc-biblatex.el deleted file mode 100644 index decb1455..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-biblatex.el +++ /dev/null @@ -1,521 +0,0 @@ -;;; citeproc-biblatex.el --- convert biblatex entries to CSL -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Convert biblatex bibliography entries to CSL. - -;;; Code: - -(require 'parse-time) -(require 'citeproc-bibtex) - -(defvar citeproc-blt-to-csl-types-alist - '((article . "article-journal") - (book . "book") - (periodical . "book") - (booklet . "pamphlet") - (bookinbook . "chapter") - (misc . "article") - (other . "article") - (standard . "legislation") - (collection . "book") - (conference . "paper-conference") - (dataset . "dataset") - (electronic . "webpage") - (inbook . "chapter") - (incollection . "chapter") - (inreference . "entry-encyclopedia") - (inproceedings . "paper-conference") - (manual . "book") - (mastersthesis . "thesis") - (mvbook . "book") - (mvcollection . "book") - (mvproceedings . "book") - (mvreference . "book") - (online . "webpage") - (patent . "patent") - (phdthesis . "thesis") - (proceedings . "book") - (reference . "book") - (report . "report") - (software . "software") - (suppbook . "chapter") - (suppcollection . "chapter") - (techreport . "report") - (thesis . "thesis") - (unpublished . "manuscript") - (www . "webpage") - (artwork . "graphic") - (audio . "song") - (commentary . "book") - (image . "figure") - (jurisdiction . "legal_case") - (legislation . "bill") ? - (legal . "treaty") - (letter . "personal_communication") - (movie . "motion_picture") - (music . "song") - (performance . "speech") - (review . "review") - (standard . "legislation") - (video . "motion_picture") - (data . "dataset") - (letters . "personal_communication") - (newsarticle . "article-newspaper")) - "Alist mapping biblatex item types to CSL item types.") - -(defun citeproc-blt--to-csl-type (type entrysubtype) - "Return the CSL type corresponding to blt TYPE and ENTRYSUBTYPE." - (pcase type - ((or 'article 'periodical 'supperiodical) - (pcase entrysubtype - ("magazine" "article-magazine") - ("newspaper" "article-newspaper") - (_ "article-journal"))) - (_ (assoc-default type citeproc-blt-to-csl-types-alist)))) - -(defvar citeproc-blt-reftype-to-genre - '(("mastersthesis" . "Master's thesis") - ("phdthesis" . "PhD thesis") - ("mathesis" . "Master's thesis") - ("resreport" . "research report") - ("techreport" . "technical report") - ("patreqfr" . "French patent request") - ("patenteu" . "European patent") - ("patentus" . "U.S. patent")) - "Alist mapping biblatex reftypes to CSL genres.") - -(defvar citeproc-blt-article-types - '(article periodical suppperiodical review) - "Article-like biblatex types.") - -(defvar citeproc-blt-chapter-types - '(inbook incollection inproceedings inreference bookinbook) - "Chapter-like biblatex types.") - -(defvar citeproc-blt-collection-types - '(book collection proceedings reference - mvbook mvcollection mvproceedings mvreference - bookinbook inbook incollection inproceedings - inreference suppbook suppcollection) - "Collection or collection part biblatex types.") - -(defvar citeproc-blt-to-csl-names-alist - '((author . author) - (editor . editor) - (bookauthor . container-author) - (translator . translator)) - "Alist mapping biblatex name fields to the corresponding CSL ones.") - -(defvar citeproc-blt-editortype-to-csl-name-alist - '(("organizer" . organizer) - ("director" . director) - ("compiler" . compiler) - ("editor" . editor) - ("collaborator" . contributor)) - "Alist mapping biblatex editortypes to CSL fields.") - -(defvar citeproc-blt-to-csl-dates-alist - '((eventdate . event-date) - (origdate . original-date) - (urldate . accessed)) - "Alist mapping biblatex date fields to the corresponding CSL ones.") - -(defconst citeproc-blt--publisher-fields - '(school institution organization howpublished publisher) - "Biblatex fields containing publisher-related information.") - -(defconst citeproc-blt--etype-to-baseurl-alist - '(("arxiv" . "https://arxiv.org/abs/") - ("jstor" . "https://www.jstor.org/stable/") - ("pubmed" ."https://www.ncbi.nlm.nih.gov/pubmed/") - ("googlebooks" . "https://books.google.com?id=")) - "Alist mapping biblatex date fields to the corresponding CSL ones.") - -(defvar citeproc-blt-to-csl-standard-alist - '(;; locators - (volume . volume) - (part . part) - (edition . edition) - (version . version) - (volumes . number-of-volumes) - (pagetotal . number-of-pages) - (chapter . chapter-number) - (pages . page) - ;; publisher - (origpublisher . original-publisher) - ;; places - (venue . event-place) - (origlocation . original-publisher-place) - (address . publisher-place) - ;; doi etcetera - (doi . DOI) - (isbn . ISBN) - (issn . ISSN) - (pmid . PMID) - (pmcid . PMCID) - (library . call-number) - ;; notes - (abstract . abstract) - (annotation . annote) - (annote . annote) ; alias for jurabib compatibility - ;; else - (pubstate . status) - (language . language) - (version . version) - (keywords . keyword) - (label . citation-label)) - "Alist mapping biblatex standard fields to the corresponding CSL ones. -Only those fields are mapped that do not require further processing.") - -(defvar citeproc-blt-to-csl-title-alist - '((eventtitle . event-title) - (origtitle . original-title) - (series . collection-title)) - "Alist mapping biblatex title fields to the corresponding CSL ones. -Only those fields are mapped that do not require further -processing.") - -(defun citeproc-blt--parse-date (d) - "Parse single biblatex date-time expression D." - ;; Remove time part, if present. - (-when-let (time-sep-pos (cl-position ?T d)) - (setq d (substring d 0 time-sep-pos))) - (--map (let ((converted (string-to-number it))) - (if (not (= converted 0)) - converted - (error "Couldn't parse '%s' as a date" d))) - (split-string d "-"))) - -(defun citeproc-blt--to-csl-date (d) - "Return a CSL version of the biblatex date field given by D." - (let* ((interval-strings (split-string d "/")) - (interval-date-parts - (mapcar #'citeproc-blt--parse-date interval-strings))) - (list (cons 'date-parts interval-date-parts)))) - -(defun citeproc-blt--get-standard (v b &optional with-nocase) - "Return the CSL-normalized value of var V from item B. -V is a biblatex var name as a string, B is a biblatex entry as an -alist. If optional WITH-NOCASE is non-nil then convert BibTeX -no-case brackets to the corresponding CSL XML spans. Return nil -if V is undefined in B." - (-when-let (blt-val (alist-get v b)) - (citeproc-bt--to-csl blt-val with-nocase))) - -(defun citeproc-blt--get-title (v b &optional with-nocase sent-case) - "Return the CSL-normalized value of a title var V from item B. -If optional WITH-NOCASE is non-nil then convert BibTeX no-case -brackets to the corresponding CSL XML spans, and if optional -SENT-CASE is non-nil the convert to sentence-case. Return nil if -V is undefined in B." - (-when-let (blt-val (alist-get v b)) - (citeproc-blt--to-csl-title blt-val with-nocase sent-case))) - -(defun citeproc-blt--to-csl-title (s with-nocase sent-case) - "Return the CSL-normalized value of a title string S. -If optional WITH-NOCASE is non-nil then convert BibTeX no-case -brackets to the corresponding CSL XML spans, and if optional -SENT-CASE is non-nil the convert to sentence-case." - (if sent-case - (citeproc-s-sentence-case-title (citeproc-bt--to-csl s t) (not with-nocase)) - (citeproc-bt--to-csl s with-nocase))) - -(defconst citeproc-blt--titlecase-langids - '("american" "british" "canadian" "english" "australian" "newzealand" - "USenglish" "UKenglish") - "List of biblatex langids with title-cased title fields.") - -(defconst citeproc-blt--langid-to-lang-alist - '(("english" . "en-US") - ("USenglish" . "en-US") - ("american" . "en-US") - ("british" . "en-GB") - ("UKenglish" . "en-GB") - ("canadian" . "en-US") - ("australian" . "en-GB") - ("newzealand" . "en-GB") - ("afrikaans" . "af-ZA") - ("arabic" . "ar") - ("basque" . "eu") - ("bulgarian" . "bg-BG") - ("catalan" . "ca-AD") - ("croatian" . "hr-HR") - ("czech" . "cs-CZ") - ("danish" . "da-DK") - ("dutch" . "nl-NL") - ("estonian" . "et-EE") - ("finnish" . "fi-FI") - ("canadien" . "fr-CA") - ("acadian" . "fr-CA") - ("french" . "fr-FR") - ("francais" . "fr-FR") - ("austrian" . "de-AT") - ("naustrian" . "de-AT") - ("german" . "de-DE") - ("germanb" . "de-DE") - ("ngerman" . "de-DE") - ("greek" . "el-GR") - ("polutonikogreek" . "el-GR") - ("hebrew" . "he-IL") - ("hungarian" . "hu-HU") - ("icelandic" . "is-IS") - ("italian" . "it-IT") - ("japanese" . "ja-JP") - ("latvian" . "lv-LV") - ("lithuanian" . "lt-LT") - ("magyar" . "hu-HU") - ("mongolian" . "mn-MN") - ("norsk" . "nb-NO") - ("nynorsk" . "nn-NO") - ("farsi" . "fa-IR") - ("polish" . "pl-PL") - ("brazil" . "pt-BR") - ("brazilian" . "pt-BR") - ("portugues" . "pt-PT") - ("portuguese" . "pt-PT") - ("romanian" . "ro-RO") - ("russian" . "ru-RU") - ("serbian" . "sr-RS") - ("serbianc" . "sr-RS") - ("slovak" . "sk-SK") - ("slovene" . "sl-SL") - ("spanish" . "es-ES") - ("swedish" . "sv-SE") - ("thai" . "th-TH") - ("turkish" . "tr-TR") - ("ukrainian" . "uk-UA") - ("vietnamese" . "vi-VN") - ("latin" . "la")) - "Alist mapping biblatex langids to CSL language codes.") - -(defun citeproc-blt-entry-to-csl (b &optional omit-nocase no-sentcase-wo-langid) - "Return a CSL form of parsed biblatex entry B. -If the optional OMIT-NOCASE is non-nil then no no-case XML -markers are generated, and if the optional NO-SENTCASE-WO-LANGID -is non-nil then title fields in items without a `langid' field -are not converted to sentence-case. - -The processing logic follows the analogous -function (itemToReference) in John MacFarlane's Pandoc, see - -Many thanks to him. - -Note: in the code, var names starting with ~ refer to values of -biblatex variables in B." - (let* ((b (cl-remove-if (lambda (x) (equal "" (cdr x))) b)) - (b (mapcar (lambda (x) (cons (intern (downcase (car x))) (cdr x))) b)) - (~type (intern (downcase (alist-get '=type= b)))) - (~entrysubtype (alist-get 'entrysubtype b)) - (type (citeproc-blt--to-csl-type ~type ~entrysubtype)) - (is-article (memq ~type citeproc-blt-article-types)) - (is-periodical (eq ~type 'periodical)) - (is-chapter-like (memq ~type citeproc-blt-chapter-types)) - (~langid (alist-get 'langid b)) - (sent-case (or (member ~langid citeproc-blt--titlecase-langids) - (and (null ~langid) (not no-sentcase-wo-langid)))) - (with-nocase (not omit-nocase)) - result) - ;; language - (when ~langid - (push (cons 'language (cdr (assoc ~langid citeproc-blt--langid-to-lang-alist))) - result)) - ;; set type and genre - (push (cons 'type type) result) - (when-let ((~reftype (alist-get 'type b))) - (push (cons 'genre (or (assoc-default ~reftype citeproc-blt-reftype-to-genre) - (citeproc-bt--to-csl ~reftype))) - result)) - ;; We store the original bib(la)tex type for filtering purposes. - (push (cons 'blt-type (symbol-name ~type)) result) - ;; names - ;; TODO: handle editorb and editorc as well... - (when-let ((~editortype (alist-get 'editortype b)) - (~editor (alist-get 'editor b)) - (csl-var (assoc-default ~editortype - citeproc-blt-editortype-to-csl-name-alist))) - (push (cons csl-var (citeproc-bt--to-csl-names ~editor)) - result)) - (when-let ((~editoratype (alist-get 'editoratype b)) - (~editora (alist-get 'editora b)) - (csl-var (assoc-default ~editoratype - citeproc-blt-editortype-to-csl-name-alist))) - (push (cons csl-var (citeproc-bt--to-csl-names ~editora)) - result)) - ;; dates - (-when-let (issued (-if-let (~issued (alist-get 'date b)) - (citeproc-blt--to-csl-date ~issued) - (-when-let (~year (alist-get 'year b)) - (citeproc-bt--to-csl-date ~year - (alist-get 'month b))))) - (push (cons 'issued issued) result)) - ;; locators - (-if-let (~number (alist-get 'number b)) - (cond ((memq ~type citeproc-blt-collection-types) ; collection - (push `(collection-number . ,~number) result)) - (is-article ; article - (push `(issue . ,(-if-let (~issue (alist-get 'issue b)) - (concat ~number ", " ~issue) - ~number)) - result)) - (t (push `(number . ,~number) result)))) - ;; titles - (let* ((~maintitle (citeproc-blt--get-title 'maintitle b with-nocase sent-case)) - (title - (cond (is-periodical (citeproc-blt--get-title 'issuetitle b with-nocase sent-case)) - ((and ~maintitle (not is-chapter-like)) ~maintitle) - (t (citeproc-blt--get-title 'title b with-nocase sent-case)))) - (subtitle (citeproc-blt--get-title - (cond (is-periodical 'issuesubtitle) - ((and ~maintitle (not is-chapter-like)) - 'mainsubtitle) - (t 'subtitle)) - b with-nocase sent-case)) - (title-addon - (citeproc-blt--get-title - (if (and ~maintitle (not is-chapter-like)) - 'maintitleaddon 'titleaddon) - b with-nocase sent-case)) - (volume-title - (when ~maintitle - (citeproc-blt--get-title - (if is-chapter-like 'booktitle 'title) b with-nocase sent-case))) - (volume-subtitle - (when ~maintitle - (citeproc-blt--get-title - (if is-chapter-like 'booksubtitle 'subtitle) b with-nocase sent-case))) - (volume-title-addon - (when ~maintitle - (citeproc-blt--get-title - (if is-chapter-like 'booktitleaddon 'titleaddon) b with-nocase sent-case))) - (container-title - (or (and is-periodical (citeproc-blt--get-title 'title b with-nocase sent-case)) - (and is-chapter-like ~maintitle) - (and is-chapter-like (citeproc-blt--get-title - 'booktitle b with-nocase sent-case)) - (or (citeproc-blt--get-title 'journaltitle b with-nocase sent-case) - ;; also accept `journal' for BibTeX compatibility - (citeproc-blt--get-title 'journal b with-nocase sent-case)))) - (container-subtitle - (or (and is-periodical (citeproc-blt--get-title - 'subtitle b with-nocase sent-case)) - (and is-chapter-like (citeproc-blt--get-title - 'mainsubtitle b with-nocase sent-case)) - (and is-chapter-like (citeproc-blt--get-title - 'booksubtitle b with-nocase sent-case)) - (citeproc-blt--get-title 'journalsubtitle b with-nocase sent-case))) - (container-title-addon - (or (and is-periodical (citeproc-blt--get-title - 'titleaddon b with-nocase sent-case)) - (and is-chapter-like (citeproc-blt--get-title - 'maintitleaddon b with-nocase sent-case)) - (and is-chapter-like - (citeproc-blt--get-title 'booktitleaddon b with-nocase sent-case)))) - (container-title-short - (or (and is-periodical (not ~maintitle) - (citeproc-blt--get-title 'titleaddon b with-nocase sent-case)) - (citeproc-blt--get-title 'shortjournal b with-nocase sent-case))) - (title-short - (or (and (or (not ~maintitle) is-chapter-like) - (citeproc-blt--get-title 'shorttitle b with-nocase sent-case)) - (and (or subtitle title-addon) - (not ~maintitle) - title)))) - (when title - (push (cons 'title - (concat title - (when subtitle (concat ": " subtitle)) - (when title-addon (concat ". " title-addon)))) - result)) - (when title-short - (push (cons 'title-short title-short) result)) - (when volume-title - (push (cons 'volume-title - (concat volume-title - (when volume-subtitle (concat ": " volume-subtitle)) - (when volume-title-addon (concat ". " volume-title-addon)))) - result)) - (when container-title - (push (cons 'container-title - (concat container-title - (when container-subtitle (concat ": " container-subtitle)) - (when container-title-addon (concat ". " container-title-addon)))) - result)) - (when container-title-short - (push (cons 'container-title-short container-title-short) result))) - ;; publisher - (-when-let (values (-non-nil (--map (citeproc-blt--get-standard it b) - citeproc-blt--publisher-fields))) - (push `(publisher . ,(mapconcat #'identity values "; ")) result)) - ;; places - (let ((csl-place-var - (if (eq ~type 'patent) 'jurisdiction 'publisher-place))) - (-when-let (~location (or (citeproc-blt--get-standard 'location b) - (citeproc-blt--get-standard 'address b))) - (push (cons csl-place-var ~location) result))) - ;; url - (-when-let (url (or (let ((u (alist-get 'url b))) (and u (citeproc-s-replace "\\" "" u))) - (when-let ((~eprinttype (or (alist-get 'eprinttype b) - (alist-get 'archiveprefix b))) - (~eprint (alist-get 'eprint b)) - (base-url - (assoc-default ~eprinttype - citeproc-blt--etype-to-baseurl-alist))) - (concat base-url ~eprint)))) - (push (cons 'URL url) result)) - ;; notes - (-when-let (note (let ((~note (citeproc-blt--get-standard 'note b)) - (~addendum (citeproc-blt--get-standard 'addendum b))) - (cond ((and ~note ~addendum) (concat ~note ". " ~addendum)) - (~note ~note) - (~addendum ~addendum) - (t nil)))) - (push (cons 'note note) result)) - ;; rest - (let (rest) - (pcase-dolist (`(,blt-key . ,blt-value) b) - ;; remaining standard vars - (-when-let (csl-key - (alist-get blt-key citeproc-blt-to-csl-standard-alist)) - (unless (alist-get csl-key result) - (push (cons csl-key (citeproc-bt--to-csl blt-value)) rest))) - ;; remaining name vars - (-when-let (csl-key - (alist-get blt-key citeproc-blt-to-csl-names-alist)) - (unless (alist-get csl-key result) - (push (cons csl-key (citeproc-bt--to-csl-names blt-value)) rest))) - ;; remaining date vars - (-when-let (csl-key - (alist-get blt-key citeproc-blt-to-csl-dates-alist)) - (unless (alist-get csl-key result) - (push (cons csl-key (citeproc-blt--to-csl-date blt-value)) rest))) - ;; remaining title vars - (-when-let (csl-key - (alist-get blt-key citeproc-blt-to-csl-title-alist)) - (push (cons csl-key - (citeproc-blt--to-csl-title blt-value with-nocase sent-case)) - rest))) - (append result rest)))) - -(provide 'citeproc-biblatex) - -;;; citeproc-biblatex.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-bibtex.el b/elpa/citeproc-20230228.1414/citeproc-bibtex.el deleted file mode 100644 index 41092cc2..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-bibtex.el +++ /dev/null @@ -1,487 +0,0 @@ -;;; citeproc-bibtex.el --- convert BibTeX entries to CSL -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Convert BibTeX bibliography entries to CSL. - -;;; Code: - -(require 'dash) -(require 'subr-x) -(require 'bibtex) -(require 'cl-lib) -(require 's) -(require 'org) -(require 'map) -;; Handle the fact that org-bibtex has been renamed to ol-bibtex -- for the time -;; being we support both feature names. -(or (require 'ol-bibtex nil t) - (require 'org-bibtex)) - -(require 'citeproc-s) - -;; Declare used ol-bibtex variables and functions to silence 'reference to free -;; variable' and 'function is not known to be defined' warnings during -;; compilation. -(defvar org-bibtex-key-property) -(defvar org-bibtex-type-property-name) -(defvar org-bibtex-export-arbitrary-fields) -(defvar org-bibtex-prefix) -(defvar org-bibtex-types) -(declare-function org-bibtex-get "ext:ol-bibtex") - -(defconst citeproc-bt--to-csl-types-alist - '(("article" . "article-journal") ("book" . "book") ("proceedings" . "book") - ("manual" . "book") ("periodical" . "book") ("booklet" . "pamphlet") - ("inbook" . "chapter") ("incollection" . "chapter") ("inproceedings" . "paper-conference") - ("conference" . "paper-conference") ("mastersthesis" . "thesis") ("phdthesis" . "thesis") - ("techreport" . "report") ("patent" . "patent") ("electronic" . "webpage") - ("misc" . "article") ("other" . "article") ("standard" . "legislation") - ("unpublished" . "manuscript") ("online" . "article-journal")) - "Alist mapping BibTeX item types to CSL item types.") - -(defconst citeproc-bt--to-csl-keys-alist - '(("=key=" . citation-label) ("address" . publisher-place) - ("booktitle" . container-title) ("journal" . container-title) - ("chapter" . title) ("location" . event-place) ("series" . collection-title) - ("keywords" . keyword) ("institution" . publisher) ("school" . publisher) - ("pages" . page) ("organization" . publisher) ("url" . URL) - ("doi" . DOI) ("pmid" . PMID) ("pmcid" . PMCID)) - "Alist mapping BibTeX keys to CSL keys with different names.") - -(defconst citeproc-bt--mon-to-num-alist - '(("jan" . 1) ("feb" . 2) ("mar" . 3) ("apr" . 4) ("may" . 5) ("jun" . 6) - ("jul" . 7) ("aug" . 8) ("sep" . 9) ("oct" . 10) ("nov" . 11) ("dec" . 12)) - "Alist mapping LaTeX abbreviated month names to ordinals.") - -(defconst citeproc-bt--pref-to-ucs-alist - '(("'" . "ACUTE") ("`" . "GRAVE") ("^" . "CIRCUMFLEX") ("~" . "TILDE") - ("=" . "MACRON") ("." . "WITH DOT ABOVE") ("\"" . "DIAERESIS") - ("''" . "DIAERESIS") ("H" . "DOUBLE ACUTE") ("r" . "WITH RING ABOVE") - ("u" . "BREVE") ("c" . "CEDILLA") ("k" . "OGONEK") ("v" . "CARON")) - "Alist mapping LaTeX prefixes to unicode name endings.") - -(defconst citeproc-bt--comm-letter-to-ucs-alist - '((("`" . "A") . "À") - (("'" . "A") . "Á") - (("^" . "A") . "Â") - (("~" . "A") . "Ã") - (("\"" . "A") . "Ä") - (("r" . "A") . "Å") - (("c" . "C") . "Ç") - (("v" . "C") . "Č") - (("'" . "C") . "Ć") - (("`" . "E") . "È") - (("'" . "E") . "É") - (("^" . "E") . "Ê") - (("\"" . "E") . "Ë") - (("`" . "I") . "Ì") - (("'" . "I") . "Í") - (("^" . "I") . "Î") - (("\"" . "I") . "Ï") - (("~" . "N") . "Ñ") - (("`" . "O") . "Ò") - (("'" . "O") . "Ó") - (("^" . "O") . "Ô") - (("~" . "O") . "Õ") - (("\"" . "O") . "Ö") - (("c" . "S") . "Ş") - (("v" . "S") . "Š") - (("`" . "U") . "Ù") - (("'" . "U") . "Ú") - (("^" . "U") . "Û") - (("\"" . "U") . "Ü") - (("'" . "Y") . "Ý") - (("`" . "a") . "à") - (("'" . "a") . "á") - (("^" . "a") . "â") - (("~" . "a") . "ã") - (("\"" . "a") . "ä") - (("r" . "a") . "å") - (("c" . "c") . "ç") - (("v" . "c") . "č") - (("'" . "c") . "ć") - (("`" . "e") . "è") - (("'" . "e") . "é") - (("^" . "e") . "ê") - (("\"" . "e") . "ë") - (("`" . "i") . "ì") - (("'" . "i") . "í") - (("^" . "i") . "î") - (("\"" . "i") . "ï") - (("~" . "n") . "ñ") - (("`" . "o") . "ò") - (("'" . "o") . "ó") - (("^" . "o") . "ô") - (("~" . "o") . "õ") - (("\"" . "o") . "ö") - (("v" . "r") . "ř") - (("c" . "s") . "ş") - (("v" . "s") . "š") - (("`" . "u") . "ù") - (("'" . "u") . "ú") - (("^" . "u") . "û") - (("\"" . "u") . "ü") - (("'" . "y") . "ý") - (("\"" . "y") . "ÿ") - (("H" . "o") . "ő") - (("H" . "O") . "Ő") - (("H" . "u") . "ű") - (("H" . "U") . "Ű") - (("v" . "z") . "ž") - (("v" . "Z") . "Ž")) - "Alist mapping LaTeX (SYMBOL-COMMAND . ASCII-CHAR) pairs to unicode characters.") - -(defconst citeproc-bt--to-ucs-alist - '(("l" . "ł") ("L" . "Ł") ("o" . "ø") ("O" . "Ø") ("AA" . "Å") ("aa" . "å") - ("AE" . "Æ") ("ae" . "æ") ("ss" . "ß") ("i" . "ı")) - "Alist mapping LaTeX commands to characters.") - -(defun citeproc-bt--to-ucs (ltx char) - "Return the unicode version of LaTeX command LTX applied to CHAR. -LTX is a one-char LaTeX accenting command (e.g. \"'\"), CHAR is -an ascii character. Return nil if no corresponding unicode -character was found." - (or (assoc-default (cons ltx char) citeproc-bt--comm-letter-to-ucs-alist) - ;; If the combination is not in citeproc-bt--comm-letter-to-ucs-alist - ;; then, as a last resort, we try to assemble the canonical unicode name - ;; of the requested character and look it up in (usc-names). This process - ;; can be *very slow* on older Emacs versions in which (usc-names) returns - ;; an alist! - - ;; NOTE: Because of a nasty interaction bug between `ucs-names' and - ;; `replace-regexp-in-string' we do the lookup only for Emacs versions - ;; earlier than 28. - (when-let* (((version< emacs-version "28" )) - (case-name (if (s-lowercase-p char) "SMALL" "CAPITAL")) - (combining-name (assoc-default ltx citeproc-bt--pref-to-ucs-alist)) - (name (concat "LATIN " case-name " LETTER " - (upcase char) " " combining-name)) - (char-name (map-elt (ucs-names) name))) - (char-to-string char-name)))) - -(defconst citeproc-bt--decode-rx - (rx (or - (seq "{\\" (group-n 1 (in "'" "`" "^" "~" "=" "." "\"")) (0+ space) - (group-n 2 letter) "}") - (seq "{\\" (group-n 1 (in "H" "r" "u" "c" "k" "v")) (1+ space) - (group-n 2 letter) "}") - (seq "{\\" (group-n 1 (or "l" "L" "o" "O" "AA" "aa" "ae" "AE" "ss" "i")) - (0+ space) "}") - (seq "\\" (group-n 1 (in "'" "`" "^" "~" "=" "." "\"" "H" "r" "u" "c" "k" "v")) - (0+ space) "{" (group-n 2 letter) "}") - (seq "\\" (group-n 1 (in "H" "r" "u" "c" "k" "v")) (1+ space) - (group-n 2 letter)) - (seq "\\" (group-n 1 (in "'" "`" "^" "~" "=" "." "\"")) (0+ space) - (group-n 2 letter)) - (seq "\\" (group-n 1 (or "l" "L" "o" "O" "AA" "aa" "ae" "AE" "ss" "i")) - word-boundary))) - "Regular expression matching BibTeX special character commands.") - -(defun citeproc-bt--decode (s) - "Decode a BibTeX encoded string." - (replace-regexp-in-string - citeproc-bt--decode-rx - (lambda (x) - (let ((command (match-string 1 x)) - (letter (match-string 2 x))) - (if letter - (or (citeproc-bt--to-ucs command letter) (concat "\\" x)) - (or (assoc-default command citeproc-bt--to-ucs-alist) x)))) - s t t)) - -(defun citeproc-bt--decode-buffer () - "Decode BibTeX encoded characters in the current buffer." - (goto-char (point-min)) - (while (re-search-forward citeproc-bt--decode-rx nil t) - (replace-match - (let ((replacement (let ((command (match-string 1)) - (letter (match-string 2))) - (if letter - (or (citeproc-bt--to-ucs command letter) (concat "\\" (match-string 0))) - (assoc-default command citeproc-bt--to-ucs-alist))))) - replacement)))) - -(defconst citeproc-bt--command-rx - (rx "\\" (1+ (any "a-z" "A-Z")) "{" ; \TEX-COMMAND{ - (group (*? anything)) ; ARGUMENT - "}" ; } - )) - -(defconst citeproc-bt--command-wo-arg-rx - (rx "\\" (1+ (any "a-z" "A-Z")) word-end)) ; \TEX-COMMAND + word-end - -(defconst citeproc-bt--braces-rx - (rx "{" (group (*? anything)) "}")) ; {TEXT} - -(defun citeproc-bt--process-brackets (s &optional lhb rhb) - "Process LaTeX curly brackets in string S. -Optional LHB and RHB specify what to substitute for left and -right braces when they are not enclosing command arguments. -The default is to remove them." - (let* ((result s) - (match t)) - (while match - (cond ((string-match citeproc-bt--command-rx result) - (setq result (replace-match "\\1" t nil result) - match t)) - ((string-match citeproc-bt--command-wo-arg-rx result) - (setq result (replace-match "" t nil result) - match t)) - ((string-match citeproc-bt--braces-rx result) - (setq result (replace-match - (concat lhb "\\1" rhb) - t nil result) - match t)) - (t (setq match nil)))) - result)) - -(defun citeproc-bt--preprocess-for-decode (s) - "Preprocess field S before decoding. -Remove flanking dumb quotes from string S and make some -replacements." - (let ((wo-quotes (if (and (string= (substring s 0 1) "\"") - (string= (substring s -1) "\"")) - (substring s 1 -1) s))) - (citeproc-s-replace "\\&" "&" wo-quotes))) - -(defun citeproc-bt--to-csl (s &optional with-nocase) - "Convert a BibTeX field S to a CSL one. -If optional WITH-NOCASE is non-nil then convert BibTeX no-case -brackets to the corresponding CSL XML spans." - (if (> (length s) 0) - (--> s - (citeproc-bt--preprocess-for-decode it) - (citeproc-bt--decode it) - (citeproc-bt--process-brackets - it - (when with-nocase "") - (when with-nocase "")) - (citeproc-s-replace-all-seq it '(("\n" . " ") ("~" . " ") ("--" . "–"))) - (s-trim it)) - s)) - -(defun citeproc-bt--to-csl-names (n) - "Return a CSL version of BibTeX names field N." - (let ((name-fields (s-split "\\band\\b" n))) - (mapcar - (lambda (x) - (let ((trimmed (s-trim x))) - (cond - ((string= trimmed "") '((family . ""))) - ;; Presence of equal sign signals extended specification. - ((string-match "=" trimmed) (citeproc-bt--ext-desc-to-csl-name trimmed)) - ;; Brackets indicate corporate entities without name parts. - ((and (string= "{" (substring trimmed 0 1)) - (string= "}" (substring trimmed -1))) - `((literal . ,(citeproc-bt--to-csl (substring trimmed 1 -1))))) - ;; Else standard bib(la)tex name field processing. - (t (citeproc-bt--to-csl-name (citeproc-bt--to-csl trimmed)))))) - name-fields))) - -(defvar citeproc-bt-dropping-particles - '("dela" "il" "sen" "z" "ze") - "List containing dropping particles. Particles whose first word -is not on this list are classified as non-dropping.") - -(defun citeproc-bt--parse-family (f) - "Parse family name tokens F into a csl name-part alist." - (let (family result particle) - (-if-let (firsts (butlast f)) - (progn - (while (and firsts (s-lowercase-p (car firsts))) - (push (pop firsts) particle)) - (when particle - (push (cons (if (member (car particle) citeproc-bt-dropping-particles) - 'dropping-particle - 'non-dropping-particle) - (nreverse particle)) - result)) - (setq family (-concat firsts (last f)))) - (setq family f)) - (push `(family . ,family) result) - result)) - -(defun citeproc-bt--parse-attr-val-field (f) - "Parse biblatex key-val field F into an alist." - (let* ((bracketless (replace-regexp-in-string "[{}]" "" f)) - (equal-split (split-string bracketless "=" t " ")) - (first-attr (intern (string-trim (pop equal-split) "[ \"]+" "[ \"]+"))) - (reversed (nreverse equal-split)) - (result (list (string-trim (pop reversed) "[ \"]+" "[ \"]+")))) - (dolist (elt reversed) - (let ((pos (- (length elt) 2)) - found) - (while (and (< 0 pos) (null found)) - (if (= (aref elt pos) ?,) - (setq found t) - (cl-decf pos))) - (unless found (error "Could not parse biblatex key-value list \"%s\"" f)) - (let ((key (intern (s-trim (substring elt (1+ pos))))) - (val (string-trim (substring elt 0 pos) "[ \"]+" "[ \"]+"))) - (push key (car result)) - (push val result)))) - (push first-attr (car result)) - result)) - -(defun citeproc-bt--ext-desc-to-csl-name (name) - "Return a CSL version of extended biblatex description NAME." - (let* ((parsed (citeproc-bt--parse-attr-val-field name)) - (dropping (string= (alist-get 'useprefix parsed) "false"))) - (--keep (pcase (car it) - ((or 'family 'given 'suffix) it) - ('prefix (cons (if dropping 'dropping-particle 'non-dropping-particle) - (cdr it))) - (_ nil)) - parsed))) - -(defun citeproc-bt--to-csl-name (name) - "Return a CSL version of BibTeX name string NAME." - (let* (result - family - (tokens (-remove #'s-blank-str-p - (citeproc-s-slice-by-matches name "\\(,\\|[[:space:]]+\\)"))) - (parts (-split-on "," tokens))) - (pcase (length parts) - ;; No commas in the name - (1 (let ((name (car parts))) - (-if-let (1st-downcased-idx (-find-index #'s-lowercase-p name)) - (progn (setq family (-slice name 1st-downcased-idx)) - (when (> 1st-downcased-idx 0) - (push `(given . ,(-slice name 0 1st-downcased-idx)) result))) - (setq family (last name)) - (when (> (length name) 1) - (push `(given . ,(-slice name 0 -1)) result))))) - ;; A single comma separates family and last name - (2 (setq family (car parts)) - (push `(given . ,(cadr parts)) result)) - ;; More than one commas - (_ (setq family (car parts)) - (push `(suffix . ,(cadr parts)) result) - (push `(given . ,(cl-caddr parts)) result))) - (setq result (nconc (citeproc-bt--parse-family family) result)) - (--map (cons (car it) (s-join " " (cdr it))) - result))) - -(defun citeproc-bt--to-csl-date (year month) - "Return a CSL version of the date given by YEAR and MONTH. -YEAR and MONTH are the values of the corresponding BibTeX fields, -MONTH might be nil." - (condition-case nil - (let ((csl-year (string-to-number (car (s-match "[[:digit:]]+" year)))) - (csl-month (when month - (assoc-default (downcase month) - citeproc-bt--mon-to-num-alist))) - date) - (when csl-year - (when csl-month (push csl-month date)) - (push csl-year date)) - (list (cons 'date-parts (list date)))) - (error - (error (concat "Couldn't parse year: '%s'" - (when month " and month: '%s'") - " as a date") - year month)))) - -(defun citeproc-bt-entry-to-csl (b) - "Return a CSL form of normalized parsed BibTeX entry B." - (let ((type (assoc-default (downcase (assoc-default "=type=" b)) - citeproc-bt--to-csl-types-alist)) - result year month) - (cl-loop for (key . value) in b do - (let ((key (downcase key)) - (value (citeproc-bt--to-csl value))) - (-if-let (csl-key (assoc-default key citeproc-bt--to-csl-keys-alist)) - ;; Vars mapped simply to a differently named CSL var - (push (cons csl-key value) result) - (pcase key - ((or "author" "editor") ; Name vars - (push (cons (intern key) (citeproc-bt--to-csl-names value)) - result)) - ("=type=" (push (cons 'type type) result)) - ("number" (push (cons (if (string= type "article-journal") 'issue - 'number) - value) - result)) - ;; Date vars that need further processing below - ("year" (setq year value)) - ("month" (setq month value)) - ;; Remaining keys are mapped without change - (_ (push (cons (intern key) value) result)))))) - (when year - (push (cons 'issued (citeproc-bt--to-csl-date year month)) - result)) - result)) - -;; This function is based on the function `org-bibtex-headline' in org-bibtex, -;; written by Bastien Guerry , Carsten Dominik and Eric Schulte . -;; Copyright (C) 2007-2017 Free Software Foundation, Inc. -(defun citeproc-bt-from-org-headline (&optional itemids) - "Return a (KEY . BIBTEX-ENTRY) pair from the headline at point. -The returned BibTeX entry has the same form as produced by -`bibtex-parse-entry'. Return nil if the headline has no -associated bibtex data. If optional ITEMIDS is given then also -return nil if the entry's key is not in ITEMIDS." - (letrec ((val (lambda (key lst) (cdr (assoc key lst)))) - (to (lambda (string) (intern (concat ":" string)))) - (from (lambda (key) (substring (symbol-name key) 1))) - (flatten (lambda (&rest lsts) - (apply #'append (mapcar - (lambda (e) - (if (listp e) (apply flatten e) (list e))) - lsts)))) - (id (org-bibtex-get org-bibtex-key-property)) - (type (org-bibtex-get org-bibtex-type-property-name))) - (when (and type (or (null itemids) (member id itemids))) - `(,id . - (("=type=" . ,type) - ,@(remove - nil - (if (and org-bibtex-export-arbitrary-fields - org-bibtex-prefix) - (mapcar - (lambda (kv) - (let ((key (car kv)) (val0 (cdr kv))) - (when (and - (string-match org-bibtex-prefix key) - (not (string= - (downcase (concat org-bibtex-prefix - org-bibtex-type-property-name)) - (downcase key)))) - (cons (downcase (replace-regexp-in-string - org-bibtex-prefix "" key)) - val0)))) - (org-entry-properties nil 'standard)) - (mapcar - (lambda (field) - (let ((value (or (org-bibtex-get (funcall from field)) - (and (eq :title field) - (nth 4 (org-heading-components)))))) - (when value (cons (funcall from field) value)))) - (funcall flatten - (funcall val :required (funcall val (funcall to type) org-bibtex-types)) - (funcall val :optional (funcall val (funcall to type) org-bibtex-types))))))))))) - -(provide 'citeproc-bibtex) - -;;; citeproc-bibtex.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-choose.el b/elpa/citeproc-20230228.1414/citeproc-choose.el deleted file mode 100644 index ee390d51..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-choose.el +++ /dev/null @@ -1,118 +0,0 @@ -;; citeproc-choose.el --- conditionally rendered CSL elements -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; CSL supports conditional rendering via the cs:choose rendering element, which -;; can contain cs:if, cs:else-if and cs:else elements as children. This file -;; contains functions corresponding to all these elements with some auxiliary -;; functions. - -;; In order to support conditional rendering by cs:choose, the functions -;; corresponding to cs:if, cs:else-if and cs:else (`citeproc--if', -;; `citeproc--else-if', `citeproc--else') return the generalized boolean value -;; of their condition in addition to their rendered content in the form of a -;; (BOOLEAN . CONTENT) pair. - -;;; Code: - -(require 's) - -(require 'citeproc-lib) -(require 'citeproc-context) -(require 'citeproc-date) - -(defun citeproc-choose-eval-conditions (attrs context) - "Eval (possibly complex) boolean conditions in ATTRS." - (-let* ((conditions (citeproc-choose--elementary-conditions - (--remove (eq (car it) 'match) attrs))) - (match (or (alist-get 'match attrs) "all")) - (values (--map (citeproc-choose--eval-elementary-condition (car it) - (intern (cdr it)) - context) - conditions))) - (pcase match - ("all" (--all? it values)) - ("any" (--any? it values)) - ("none" (--none? it values))))) - -(defun citeproc-choose--elementary-conditions (attrs) - "Expand complex conditions in ATTRS into elementary ones. -Return a list of elementary (CONDITION-TYPE . PARAM) pairs." - (cl-mapcan (lambda (x) - (--map (cons (car x) it) - (s-split " " (cdr x)))) - attrs)) - -(defun citeproc-choose--eval-elementary-condition (type param context) - "Evaluate an elementary choose condition of TYPE with PARAM. -TYPE is one of the symbols `variable', `type', `locator', -`is-numeric', `is-uncertain-date', `position' and `disambiguate'. -Return the result of evaluation, which is a generalized boolean." - (pcase type - ('variable (citeproc-var-value param context)) - ('type (string= param (citeproc-var-value 'type context))) - ('locator (string= param (citeproc-var-value 'label context))) - ('is-numeric (let ((val (citeproc-var-value param context))) - (citeproc-lib-numeric-p val))) - ;; We return t iff the first date is uncertain. A more complicated alternative - ;; would be to test the second date of date ranges as well. - ('is-uncertain-date (-when-let (dates (citeproc-var-value param context)) - (citeproc-date-circa (car dates)))) - ('position (and (eq (citeproc-context-mode context) 'cite) - (or (and (eq param 'near-note) (citeproc-var-value 'near-note context)) - (let ((pos (citeproc-var-value 'position context))) - (or (eq param pos) - (and (eq param 'subsequent) - (or (eq pos 'ibid) (eq pos 'ibid-with-locator))) - (and (eq param 'ibid) - (eq pos 'ibid-with-locator))))))) - ('disambiguate (citeproc-var-value 'disambiguate context)))) - -(defmacro citeproc--choose (_attrs _context &rest body) - "Return the content of the first element in BODY with t boolean value. -Return the empty (nil . `text-only') content if there is no such -element." - `(let ((first-true - (--first (car it) (list ,@body)))) - (if first-true - (cdr first-true) - (cons nil (quote text-only))))) - -(defmacro citeproc--if (attrs context &rest body) - "If conditions in ATTRS eval to t return t with rendered BODY. -Return nil otherwise." - `(if (citeproc-choose-eval-conditions ,attrs ,context) - (cons t (citeproc-lib-add-splice-tag - (citeproc-lib-splice-into (list ,@body) 'splice) - 'splice)) - nil)) - -(defalias 'citeproc--else-if 'citeproc--if) - -(defun citeproc--else (_attrs _context &rest body) - "Always return t boolean plus rendered BODY" - (let ((spliced-body (citeproc-lib-splice-into body 'splice))) - (cons t (citeproc-lib-add-splice-tag spliced-body 'splice)))) - -(provide 'citeproc-choose) - -;;; citeproc-choose.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-cite.el b/elpa/citeproc-20230228.1414/citeproc-cite.el deleted file mode 100644 index 729ad138..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-cite.el +++ /dev/null @@ -1,578 +0,0 @@ -;;; citeproc-cite.el --- cite and citation rendering -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functionality to render citations and the cites they contain. (Terminology -;; from the CSL standard: "citations consist of one or more cites to individual -;; items".) - -;;; Code: - -(require 'cl-lib) -(require 'dash) -(require 'queue) -(require 's) - -(require 'citeproc-rt) -(require 'citeproc-number) -(require 'citeproc-itemdata) -(require 'citeproc-style) -(require 'citeproc-proc) -(require 'citeproc-formatters) -(require 'citeproc-sort) -(require 'citeproc-subbibs) - -(cl-defstruct (citeproc-citation (:constructor citeproc-citation-create)) - "A struct representing a citation. -CITES is a list of alists describing individual cites, -NOTE-INDEX is the note index of the citation if it occurs in a - note, -MODE is either nil (for the default citation mode) or one - of the symbols `suppress-author', `textual', `author-only', - `year-only', `title-only', `bib-entry', `locator-only', -SUPPRESS-AFFIXES is non-nil if the citation affixes should be - suppressed, -CAPITALIZE-FIRST is non-nil if the first word of the rendered - citation should be capitalized, -IGNORE-ET-AL is non-nil if et-al settings should be ignored for - the first cite. -GROUPED is used internally to indicate whether the cites were - grouped by the csl processor." - cites note-index mode suppress-affixes capitalize-first - ignore-et-al grouped) - -(defconst citeproc-cite--from-mode-alist - '((textual . ((suppress-author . t))) - (suppress-author . ((suppress-author . t))) - (author-only . ((stop-rendering-at . names))) - (year-only . ((stop-rendering-at . issued))) - (title-only . ((stop-rendering-at . title) (bib-entry . t) (use-short-title . t))) - (bib-entry . ((bib-entry . t))) - (locator-only . ((locator-only . t)))) - "Alist mapping citation modes to corresponding cite-level -key-value pair representations.") - -(defvar citeproc-citation-postprocess-functions nil - "A list of functions to postprocess rendered citations. -Each function takes a single argument, a rich-text, and returns a -post-processed rich-text value. The functions are applied in the -order they appear in the list.") - -(defun citeproc-cite--varlist (cite) - "Return the varlist belonging to CITE." - (let* ((itd (alist-get 'itd cite)) - (item-vv (citeproc-itemdata-varvals itd)) - ;; OPTIMIZE: Should we do this filtering? - (cite-vv - (--filter (memq (car it) - '(label locator suppress-author suppress-date - stop-rendering-at position near-note - first-reference-note-number ignore-et-al - bib-entry locator-only use-short-title)) - cite))) - (nconc cite-vv item-vv))) - -(defun citeproc-cite--render (cite style &optional internal-links) - "Render CITE in STYLE, together with its affixes. -If the prefix or suffix in CITE don't contain trailing and -leading spaces then they are added. If the optional -INTERNAL-LINKS is `bib-links' then link cites to the bibliography -regardless of the style type, if `no-links' then don't add -internal links, if nil or `auto' then add internal links based on -the style type (cite-cite links for note styles and cite-bib -links else). For legacy reasons, any other value is treated as -`no-links'." - (-let* ((result nil) - ((&alist 'suffix suff - 'prefix pref - 'bib-entry bib-entry - 'locator-only locator-only - 'stop-rendering-at stop-rendering-at) - cite) - (rt-pref (citeproc-rt-from-str pref)) - (plain-pref (citeproc-rt-to-plain rt-pref)) - (rt-suff (citeproc-rt-from-str suff)) - (plain-suff (citeproc-rt-to-plain rt-suff)) - (mode (if bib-entry 'bib 'cite)) - (varlist (citeproc-cite--varlist cite))) - ;; Remove cite-number when cite is the full bibliography entry. - (when (and (eq mode 'bib) (not stop-rendering-at)) - (push '(citation-number) varlist)) - (let ((rendered-varlist - (citeproc-render-varlist-in-rt - varlist style mode 'display - ;; No link-targets for bib-entry based citations. - (if (eq mode 'bib) 'no-links internal-links) - ;; No external limking for title-only citations, since we link to the - ;; corresponding bibliography entry. - (eq stop-rendering-at 'title)))) - ;; Locator-only cites require extensive post-processing of full cite. - (when locator-only - (setq rendered-varlist (citeproc-rt-locator-w-label rendered-varlist))) - ;; Title-only cites - (when (eq stop-rendering-at 'title) - (when-let* ((cite-no-attr - (citeproc-context-int-link-attrval - style internal-links 'cite (alist-get 'position varlist))) - (cite-no-attr-val (cons cite-no-attr - (alist-get 'citation-number varlist)))) - ;; Add cited-item-no attr to link to the bibliography entry - (setf (car rendered-varlist) - (-snoc (car rendered-varlist) cite-no-attr-val)))) - ;; Add cite prefix and suffix - (when (s-present-p plain-suff) - (push (citeproc-rt-from-str suff) result) - (unless (memql (aref plain-suff 0) '(?, ?\s)) - (push " " result))) - (push rendered-varlist result) - (when (s-present-p plain-pref) - (unless (= (aref plain-pref (1- (length plain-pref))) ?\s) - (push " " result)) - (push rt-pref result)) - (citeproc-rt-join-formatted nil result nil)))) - -(defun citeproc-cite-or-citegroup--render (c style internal-links top-dl gr-dl ys-dl ac-dl) - "Render cite or cite-group C with STYLE. -For the INTERNAL-LINKS argument see `citeproc-cite--render'. -TOP-DL is the top-, GR-DL the group-, YS-DL the year-suffix- and -AC-DL the after-collapse-delimiter to use." - (cond ((and (car c) (memq (car c) '(top group year-suffix-collapsed))) - (let ((delimiter (pcase (car c) - ('top top-dl) - ('group gr-dl) - ('year-suffix-collapsed ys-dl)))) - (cons - nil ; empty attribute list - (nbutlast ; remove last delimiter - (--mapcat (list (citeproc-cite-or-citegroup--render - it style internal-links top-dl gr-dl ys-dl ac-dl) - (if (and (car it) (memq (car it) '(group year-suffix-collapsed))) - ac-dl - delimiter)) - (cdr c)))))) - ((eq (car c) 'range) - (list nil (citeproc-cite--render (cl-second c) style internal-links) - "–" (citeproc-cite--render (cl-third c) style internal-links))) - (t (citeproc-cite--render c style internal-links)))) - -(defun citeproc-citation--render (c proc &optional internal-links) - "Render citation C with CSL processor PROC. -For the optional INTERNAL-LINKS argument see -`citeproc-cite--render'." - (let* ((style (citeproc-proc-style proc)) - (punct-in-quote - (string= (alist-get 'punctuation-in-quote (citeproc-style-locale-opts style)) - "true")) - (cites (citeproc-citation-cites c)) - (cite-attrs (citeproc-style-cite-layout-attrs style)) - (cite-layout-dl (alist-get 'delimiter cite-attrs))) - ;; Remove delimiters from cite-attrs -- they are rendered 'manually' because of - ;; the delimiter-after-collapse complications in rendering. Also remove affixes - ;; if requested. - (setq cite-attrs - (if (citeproc-citation-suppress-affixes c) - (--remove (memq (car it) '(delimiter prefix suffix)) cite-attrs) - (--remove (eq (car it) 'delimiter) cite-attrs))) - ;; Generate rendered cites - (let ((rendered-cites - (cond - ((citeproc-citation-grouped c) - (let ((gr-dl - (alist-get 'cite-group-delimiter (citeproc-style-cite-opts style))) - (ys-dl - (alist-get 'year-suffix-delimiter (citeproc-style-cite-opts style))) - (aft-coll-dl - (alist-get - 'after-collapse-delimiter (citeproc-style-cite-opts style)))) - (cdr (citeproc-cite-or-citegroup--render - (cons 'top cites) ; indicate top level input - style internal-links cite-layout-dl gr-dl ys-dl aft-coll-dl)))) - ((cdr cites) - (cdr (--mapcat - (list cite-layout-dl (citeproc-cite--render it style internal-links)) - cites))) - (t - (list (citeproc-cite--render (car cites) style internal-links)))))) - ;; Calculate inner and outer citation attrs (affixes go inside) - (let* ((non-affixes (--remove (memq (car it) '(prefix suffix delimiter)) cite-attrs)) - (affixes (--filter (memq (car it) '(prefix suffix)) cite-attrs)) - (outer-attrs (and affixes non-affixes)) - (result - (citeproc-rt-cull-spaces-puncts - (citeproc-rt-finalize - (citeproc-rt-render-affixes - (citeproc-rt-join-formatted (if outer-attrs affixes cite-attrs) - rendered-cites nil) - t) - punct-in-quote)))) - ;; Add outer (non-affix attrs) if needed - (when outer-attrs - (setq result (list outer-attrs result))) - ;; Prepend author to textual citations - (when (eq (citeproc-citation-mode c) 'textual) - (let* ((first-elt (car cites)) ;; First elt is either a cite or a cite group. - ;; If the latter then we need to locate the - ;; first cite as the 2nd element of the first - ;; cite group. - (first-cite (if (eq 'group (car first-elt)) - (cadr first-elt) - first-elt)) - (author-cite - (append '((suppress-author . nil) (stop-rendering-at . names) - (prefix) (suffix) (locator)) - first-cite)) - (rendered-author (citeproc-cite--render author-cite style 'no-links))) - (when (listp rendered-author) - (setq result `(nil ,rendered-author " " ,result))))) - ;; Capitalize first - (when (citeproc-citation-capitalize-first c) - (setq result (citeproc-rt-change-case result #'citeproc-s-capitalize-first))) - ;; Run the citation postprocessing hook - (dolist (fn citeproc-citation-postprocess-functions) - (setq result (funcall fn result))) - result)))) - -(defun citeproc-cites--collapse-indexed (cites index-getter no-span-pred) - "Collapse continuously indexed cites in CITES. -INDEX-GETTER is a function from cites to numeric indices, -NO-SPAN-PRED is a predicate that returns non-nil for cites that -cannot be part of a span. Return the collapsed cites list or nil -if no cites were collapsed." - (let (group-len start-cite prev-index end-cite result) - (dolist (cite cites) - (let* ((cur-index (funcall index-getter cite)) - (no-span-elt (funcall no-span-pred cite)) - (subsequent (and prev-index (= (1+ prev-index) cur-index)))) - ;; Process ending current group - (when (and group-len (or no-span-elt (not subsequent))) - (setq result (nconc (citeproc-cite-range--collapse - start-cite end-cite - group-len) - result))) - (cond (no-span-elt ; Not only cite-no - (push cite result) - (setq group-len nil)) - ((or (not group-len) (not subsequent)) ; New group starts - (setq group-len 1 - start-cite cite - prev-index cur-index)) - (t ; Group continues - (cl-incf group-len) - (setq end-cite cite - prev-index cur-index))))) - ;; Process the last group - (when group-len - (setq result (nconc (citeproc-cite-range--collapse - start-cite end-cite group-len) - result))) - (if (/= (length cites) (length result)) - (nreverse result) - nil))) - -(defun citeproc-cite-range--collapse (start-cite end-cite len) - "Collapse cite span with START-CITE, END-CITE of LEN length. -START-CITE end END-CITE is the first and last rendered cites of -the span." - (pcase len - (1 (list start-cite)) - (2 (list end-cite start-cite)) - (_ (list (list 'range start-cite end-cite))))) - -(defun citeproc-citation--collapse-num-citeranges (citation) - "Collapse numbered ranges in CITATION." - (let* ((cites (citeproc-citation-cites citation)) - (cites-length (length cites))) - (when (> cites-length 2) - (-when-let (collapsed - (citeproc-cites--collapse-indexed - cites - (lambda (x) - (string-to-number - (alist-get 'citation-number (citeproc-cite--varlist x)))) - (lambda (x) (alist-get 'locator (citeproc-cite--varlist x))))) - (setf (citeproc-citation-cites citation) collapsed - (citeproc-citation-grouped citation) t))))) - -(defun citeproc-cites--collapse-suff-citeranges (cites) - "Collapse continuously year-suffixed CITES." - (or (citeproc-cites--collapse-indexed - cites - (lambda (x) - (string-to-char (alist-get 'year-suffix (citeproc-cite--varlist x) " "))) - (lambda (_x) nil)) - cites)) - -(defun citeproc-citation--render-formatted-citation (c proc format &optional internal-links) - "Render citation C with csl processor PROC in FORMAT. -For the optional INTERNAL-LINKS argument see -`citeproc-cite--render'." - (let ((fmt (citeproc-formatter-for-format format))) - (funcall (citeproc-formatter-cite fmt) - (funcall (citeproc-formatter-rt fmt) - (citeproc-citation--render c proc internal-links))))) - -(defun citeproc-citation--sort-cites (citation proc) - "Sort cites in CITATION for processor PROC." - (let ((cites (citeproc-citation-cites citation))) - (when (cdr cites) - (let* ((style (citeproc-proc-style proc)) - (sort-orders (citeproc-style-cite-sort-orders style))) - (setf (citeproc-citation-cites citation) - (sort - (--map (cons (cons 'key ; add keys to the cites as extra attr - (citeproc-sort--render-keys style (citeproc-cite--varlist it) 'cite)) - it) - cites) - (lambda (x y) (citeproc-sort--compare-keylists (cdar x) (cdar y) sort-orders)))))))) - -(defun citeproc-proc-sort-cites (proc) - "Sort cites in all citations of PROC." - (when (citeproc-style-cite-sort (citeproc-proc-style proc)) - (dolist (citation (queue-head (citeproc-proc-citations proc))) - (citeproc-citation--sort-cites citation proc)))) - -(defun citeproc-proc-apply-citation-modes (proc) - "Apply mode to the first cite in each citation in PROC." - (dolist (citation (queue-head (citeproc-proc-citations proc))) - (let ((mode (citeproc-citation-mode citation)) - (cites (citeproc-citation-cites citation)) - (ignore-et-al (citeproc-citation-ignore-et-al citation))) - (-when-let (mode-rep - (alist-get mode citeproc-cite--from-mode-alist)) - (setf (car cites) (nconc (car cites) mode-rep))) - (when ignore-et-al - (push '(ignore-et-al . t) (car cites)))))) - -(defun citeproc-proc-group-and-collapse-cites (proc) - "Group and collapse cites in all citations of PROC." - (let* ((cite-opts (citeproc-style-cite-opts (citeproc-proc-style proc))) - (group-delim (alist-get 'cite-group-delimiter cite-opts)) - (collapse-type (alist-get 'collapse cite-opts)) - (collapse-year-type - (when collapse-type - (let ((cy (member collapse-type - '("year" "year-suffix" "year-suffix-ranged")))) - (and cy (car cy)))))) - ;; Collapse (and group) according to collapse type - (cond ((or group-delim collapse-year-type) - ;; Group and possibly collapse - (dolist (citation (queue-head (citeproc-proc-citations proc))) - (citeproc-citation--group-and-collapse-cites citation proc collapse-type))) - ;; Collapse numeric cites - ((string= collapse-type "citation-number") - (dolist (citation (queue-head (citeproc-proc-citations proc))) - (citeproc-citation--collapse-num-citeranges citation)))))) - -(defun citeproc-citation--group-and-collapse-cites (c proc &optional collapse-type) - "Divide items in citation C in place into groups for PROC. -Apart from movement necessary for grouping, the relative -positions of cites in C is kept. If optional COLLAPSE-TYPE is -given then collapse the groups accordingly." - (let ((cites (citeproc-citation-cites c))) - (when (cdr cites) - (let (groups) - (dolist (cite cites) - (let ((g-ind - ;; Cites are in the same group iff the cdrs of the rendered cite's first - ;; name-var are equal. The cdr is taken because we ignore attributes, in - ;; particular the cited-item-no attribute which is added when the cite consists - ;; entirely of the rendered name var - (--find-index (equal (cdr (citeproc-cite--first-namevar-cont cite proc)) - (cdr (citeproc-cite--first-namevar-cont (car it) proc))) - groups))) - (if g-ind - (push cite (nth g-ind groups)) - (push (list cite) groups)))) - (unless (= (length groups) (length cites)) - (setf (citeproc-citation-cites c) - (nreverse - (--map (if (cdr it) - (cons 'group - (pcase collapse-type - ("year" - (citeproc-citation-group--collapse-year (nreverse it))) - ("year-suffix" - (citeproc-citation-group--collapse-ys (nreverse it) proc nil)) - ("year-suffix-ranged" - (citeproc-citation-group--collapse-ys (nreverse it) proc t)) - (_ (nreverse it)))) - (car it)) - groups)) - (citeproc-citation-grouped c) t)))))) - -(defun citeproc-citation-group--collapse-year (cites) - "Collapse year in group CITES." - (cons (car cites) - (--map (cons '(suppress-author . t) it) - (cdr cites)))) - -(defun citeproc-citation-group--collapse-ys (cites proc collapse-ranges) - "Collapse year and suffix in group CITES using PROC. -If optional COLLAPSE-RANGES is non-nil then collapse year-suffix -ranges." - (let ((first t) (groups (list (list (car cites)))) - prev-datevar-cont prev-locator) - (dolist (cite cites) - (let* ((varlist (citeproc-cite--varlist cite)) - (datevar-cont (cadr (citeproc-cite--first-datevar-cont cite proc))) - (locator (alist-get 'locator varlist))) - (cond (first - (setq first nil)) - ((or prev-locator - locator - (not (alist-get 'year-suffix varlist)) - (not (equal datevar-cont prev-datevar-cont))) - (push (list (cons '(suppress-author . t) - cite)) - groups)) - (t - (push (cons '(suppress-date . t) - (cons '(suppress-author . t) - cite)) - (car groups)))) - (setq prev-datevar-cont datevar-cont - prev-locator locator)) - cites) - (nreverse - (--map (if (cdr it) - (cons 'year-suffix-collapsed - (if (and collapse-ranges (> (length cites) 2)) - (citeproc-cites--collapse-suff-citeranges (nreverse it)) - (nreverse it))) - (car it)) - groups)))) - -(defun citeproc-citations--itd-referred-p (itd citations) - "Whether ITD is referred to in CITATIONS." - (let ((cites (--mapcat (citeproc-citation-cites it) citations))) - (--any-p (eq itd (alist-get 'itd it)) cites))) - -(defun citeproc-cite--update-nn-queue (q index nnd) - "Remove too distant citations from near-notes queue Q. -INDEX is the actual note-index, NND is the near-note-distance." - (while (and (queue-head q) - (< nnd (- index - (citeproc-citation-note-index (queue-first q))))) - (queue-dequeue q))) - -(defun citeproc-cite--loc-equal-p (s1 s2) - "Whether locator strings S1 and S2 refer to the same location." - (if (and (citeproc-lib-numeric-p s1) (citeproc-lib-numeric-p s2)) - (equal (citeproc-number-extract s1) (citeproc-number-extract s2)) - (string= (s-trim s1) (s-trim s2)))) - -(defvar citeproc-disambiguation-cite-pos 'last - "Which cite position should be the basis of cite disambiguation. -Possible values are `last', `first' and `subsequent'.") - -(defun citeproc-proc-update-positions (proc) - "Update all position-related fields in PROC." - (citeproc-proc-delete-occurrence-info proc) - (let* ((ctns (queue-head (citeproc-proc-citations proc))) - (cite-opts (citeproc-style-cite-opts (citeproc-proc-style proc))) - (nnd (string-to-number - (or (alist-get 'near-note-distance cite-opts) - "5"))) - (near-note-ctns (make-queue)) - prev-itd prev-loc prev-label) - (unless (eq citeproc-disambiguation-cite-pos 'last) - (dolist (itd (hash-table-values - (citeproc-proc-itemdata proc))) - (setf (citeproc-itemdata-disamb-pos itd) citeproc-disambiguation-cite-pos))) - (dolist (ctn ctns) - (let* ((note-ind (citeproc-citation-note-index ctn)) - (cites (citeproc-citation-cites ctn)) - (single-cite (not (cdr cites)))) - (when note-ind (citeproc-cite--update-nn-queue near-note-ctns note-ind nnd)) - (let (seen-itds) - (while cites - (let* ((cite (car cites)) - (itd (alist-get 'itd cite)) - (locator (alist-get 'locator cite)) - (label (alist-get 'label cite)) - (pos (if (citeproc-itemdata-occurred-before itd) - (if (eq itd prev-itd) - (if prev-loc - (if locator - (if (and (citeproc-cite--loc-equal-p prev-loc locator) - (string= prev-label label)) - 'ibid - 'ibid-with-locator) - 'subsequent) - (if locator 'ibid-with-locator 'ibid)) - 'subsequent) - 'first))) - (when (and note-ind - (or (citeproc-citations--itd-referred-p itd (queue-head near-note-ctns)) - (memq itd seen-itds))) - (setf (alist-get 'near-note (car cites)) t)) - (setf (alist-get 'position (car cites)) pos - prev-itd itd - prev-loc locator - prev-label label) - (when (eq citeproc-disambiguation-cite-pos 'last) - (citeproc-itd-update-disamb-pos itd pos)) - (let ((prev-occurrence (citeproc-itemdata-occurred-before itd))) - (if prev-occurrence - (unless (eq t prev-occurrence) - (setf (alist-get 'first-reference-note-number (car cites)) - (number-to-string prev-occurrence))) - (setf (citeproc-itemdata-occurred-before itd) (or note-ind t)))) - (push itd seen-itds) - (pop cites)))) - (unless single-cite - (setq prev-itd nil prev-loc nil prev-label nil)) - (when note-ind (queue-append near-note-ctns ctn)))))) - -(defun citeproc-proc-finalize (proc) - "Finalize processor PROC by sorting and disambiguating items." - (unless (citeproc-proc-finalized proc) - (citeproc-proc-process-uncited proc) - (citeproc-sb-add-subbib-info proc) - (citeproc-sb-prune-unrendered proc) - (citeproc-proc-update-sortkeys proc) - (citeproc-proc-sort-itds proc) - (citeproc-proc-update-positions proc) - (citeproc-proc-disamb proc) - (citeproc-proc-sort-cites proc) - (citeproc-proc-apply-citation-modes proc) - (citeproc-proc-group-and-collapse-cites proc) - (setf (citeproc-proc-finalized proc) t))) - -(defun citeproc-cite--first-namevar-cont (cite proc) - "Return the first raw name-var node of CITE rendered with PROC." - (citeproc-rt-find-first-node - (citeproc-itd-rt-cite (alist-get 'itd cite) (citeproc-proc-style proc)) - (lambda (x) - (and (consp x) (memq (alist-get 'rendered-var (car x)) - citeproc--name-vars))))) - -(defun citeproc-cite--first-datevar-cont (cite proc) - "Return the first raw date-var node of CITE rendered with PROC." - (citeproc-rt-find-first-node - (citeproc-itd-rt-cite (alist-get 'itd cite) (citeproc-proc-style proc)) - (lambda (x) - (and (consp x) (memq (alist-get 'rendered-var (car x)) - citeproc--date-vars))))) -(provide 'citeproc-cite) - -;;; citeproc-cite.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-context.el b/elpa/citeproc-20230228.1414/citeproc-context.el deleted file mode 100644 index c32940e6..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-context.el +++ /dev/null @@ -1,282 +0,0 @@ -;;; citeproc-context.el --- rendering context for CSL elements -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides the `citeproc-context' CL-structure type to represent rendering -;; contexts for CSL elements, and functions for accessing context-dependent -;; information (variable and term values etc.). Also contains some functions -;; that perform context-dependent formatting (e.g., quoting). - -;;; Code: - -(require 'let-alist) -(require 'subr-x) - -(require 'citeproc-lib) -(require 'citeproc-rt) -(require 'citeproc-term) -(require 'citeproc-prange) -(require 'citeproc-style) - -(cl-defstruct (citeproc-context (:constructor citeproc-context--create)) - "A struct representing the context for rendering CSL elements." - vars macros terms date-text date-numeric opts locale-opts - mode render-mode render-year-suffix no-external-links locale) - -(defun citeproc-context-create (var-alist style mode render-mode - &optional no-external-links) - "Create a citeproc-context struct from var-values VAR-ALIST and csl style STYLE. -MODE is either `bib' or `cite', RENDER-MODE is `display' or `sort'." - (citeproc-context--create - :vars var-alist - :macros (citeproc-style-macros style) - :terms (citeproc-style-terms style) - :date-text (citeproc-style-date-text style) - :date-numeric (citeproc-style-date-numeric style) - :opts (citeproc-style-global-opts style mode) - :locale (citeproc-style-locale style) - :locale-opts (citeproc-style-locale-opts style) - :mode mode - :render-mode render-mode - :render-year-suffix (not (citeproc-style-uses-ys-var style)) - :no-external-links no-external-links)) - -(defconst citeproc--short-long-var-alist - '((title . title-short) (container-title . container-title-short)) - "Alist mapping the long form of variables names to their short form.") - -(defun citeproc-var-value (var context &optional form) - "Return the value of csl variable VAR in CONTEXT. -VAR is a symbol, CONTEXT is a `citeproc-context' struct, and the -optional FORM can be nil, `short' or `long'." - (let ((var-vals (citeproc-context-vars context))) - (if (or (eq form 'short) - ;; Also use the short form of title when the cite contains the - ;; (use-short-title . t) pair. This is used for title-only citations. - (and (eq var 'title) (alist-get 'use-short-title var-vals))) - (-if-let* ((short-var (alist-get var citeproc--short-long-var-alist)) - (short-var-val (alist-get short-var var-vals))) - short-var-val - (alist-get var var-vals)) - (let ((var-val (alist-get var var-vals))) - (if (and var-val (or (and (eq var 'locator) - (string= (citeproc-var-value 'label context) "page")) - (eq var 'page))) - (let ((prange-format (citeproc-lib-intern (alist-get 'page-range-format - (citeproc-context-opts context)))) - (sep (or (citeproc-term-text-from-terms "page-range-delimiter" - (citeproc-context-terms context)) - "–"))) - (citeproc-rt-from-str (citeproc-prange-render var-val prange-format sep))) - var-val))))) - -(defun citeproc-locator-label (context) - "Return the current locator label variable from CONTEXT." - (citeproc-var-value 'label context)) - -(defun citeproc-rt-quote (rt context) - "Return the quoted version of rich-text RT using CONTEXT." - (let ((oq (citeproc-term-get-text "open-quote" context)) - (cq (citeproc-term-get-text "close-quote" context)) - (oiq (citeproc-term-get-text "open-inner-quote" context)) - (ciq (citeproc-term-get-text "close-inner-quote" context))) - `(,oq ,@(citeproc-rt-replace-all-sim `((,oq . ,oiq) (,cq . ,ciq) - (,oiq . ,oq) (,ciq . ,cq)) - (format "\\(%s\\|%s\\|%s\\|%s\\)" oq cq oiq ciq) - rt) - ,cq))) - -(defun citeproc-rt-textcased (rts case context) - "Return rich-text content RTS in text-case CASE using CONTEXT. -CASE is one of the following: `lowercase', `uppercase', -`capitalize-first', `capitalize-all', `sentence', `title'." - (pcase case - ('uppercase - (citeproc-rt-map-strings #'upcase rts t)) - ('lowercase - (citeproc-rt-map-strings #'downcase rts t)) - ('capitalize-first - (--map (citeproc-rt-change-case it #'citeproc-s-capitalize-first) rts)) - ('capitalize-all - (--map (citeproc-rt-change-case it #'citeproc-s-capitalize-all) rts)) - ('sentence - (--map (citeproc-rt-change-case it #'citeproc-s-sentence-case) rts)) - ('title - (let ((locale (citeproc-context-locale context)) - (language (citeproc-var-value 'language context))) - (if (or (and language (string-prefix-p "en" language)) - (and (null language) - (or (and locale (string-prefix-p "en" locale)) - (null locale)))) - (--map (citeproc-rt-change-case it #'citeproc-s-title-case) rts) - rts))))) - -(defun citeproc-rt-join-formatted (attrs rts context) - "Join and format according to ATTRS the rich-texts in RTS." - (let-alist attrs - (let ((result (delq nil rts))) - (when .text-case - (setq result (citeproc-rt-textcased result (intern .text-case) context))) - (when (string= .strip-periods "true") (setq result (citeproc-rt-strip-periods result))) - (when (string= .quotes "true") (setq result (citeproc-rt-quote result context))) - (push (citeproc-rt-select-attrs attrs citeproc-rt-ext-format-attrs) result) - (if (and .delimiter - (> (length result) 2)) - result - (citeproc-rt-simplify-shallow result))))) - -(defun citeproc-rt-format-single (attrs rt context) - "Format according to ATTRS rich-text RT using CONTEXT." - (if (or (not rt) (and (char-or-string-p rt) (string= rt ""))) - nil - (citeproc-rt-join-formatted attrs (list rt) context))) - -(defun citeproc-rt-typed-join (attrs typed-rts context) - "Join and format according to ATTRS contents in list TYPED-RTS. -TYPED RTS is a list of (RICH-TEXT . TYPE) pairs" - (-let* ((types (--map (cdr it) typed-rts)) - (type (cond ((--all? (eq it 'text-only) types) - 'text-only) - ((--any? (eq it 'present-var) types) - 'present-var) - (t 'empty-vars)))) - (cons (citeproc-rt-join-formatted attrs - (--map (car it) typed-rts) - context) - type))) - -(defun citeproc-term-get-text (term context) - "Return the first text associated with TERM in CONTEXT." - (citeproc-term-text-from-terms term (citeproc-context-terms context))) - -(defun citeproc-term-inflected-text (term form number context) - "Return the text associated with TERM having FORM and NUMBER." - (let ((matches - (--select (string= term (citeproc-term-name it)) - (citeproc-context-terms context)))) - (cond ((not matches) nil) - ((= (length matches) 1) - (citeproc-term-text (car matches))) - (t (citeproc-term--inflected-text-1 matches form number))))) - -(defconst citeproc--term-form-fallback-alist - '((verb-short . verb) - (symbol . short) - (verb . long) - (short . long)) - "Alist containing the fallback form for each term form.") - -(defun citeproc-term--inflected-text-1 (matches form number) - (let ((match (--first (and (eq form (citeproc-term-form it)) - (or (not (citeproc-term-number it)) - (eq number (citeproc-term-number it)))) - matches))) - (if match - (citeproc-term-text match) - (citeproc-term--inflected-text-1 - matches - (alist-get form citeproc--term-form-fallback-alist) - number)))) - -(defun citeproc-term-get-gender (term context) - "Return the gender of TERM or nil if none is given." - (-if-let (match - (--first (and (string= (citeproc-term-name it) term) - (citeproc-term-gender it) - (eq (citeproc-term-form it) 'long)) - (citeproc-context-terms context))) - (citeproc-term-gender match) - nil)) - -(defun citeproc-context-int-link-attrval (style internal-links mode cite-pos) - "Return an appropriate attribute to represent internal linking info. -INTERNAL-LINKS is the internal linking mode, see the -documentation of `citeproc-render-varlist-in-rt', while MODE is -the rendering mode, `bib' or `cite', and CITE-POS is a cite -position. Returns an appropriate attribute to be added or nil if -no internal links should be produced." - (let ((note-style (citeproc-style-cite-note style))) - (unless (or (and internal-links (not (memq internal-links '(auto bib-links)))) - (and note-style (eq mode 'bib) (or (null internal-links) - (eq internal-links 'auto)))) - (if (and note-style (not (eq internal-links 'bib-links))) - ;; For note styles link subsequent cites to the first ones. - (if (eq cite-pos 'first) 'bib-item-no 'cited-item-no) - ;; Else link each cite to the corresponding bib item. - (if (eq mode 'cite) 'cited-item-no 'bib-item-no))))) - -(defun citeproc-render-varlist-in-rt (var-alist style mode render-mode &optional - internal-links no-external-links) - "Render an item described by VAR-ALIST with STYLE in rich-text. -Does NOT finalize the rich-text rendering. MODE is either `bib' -or `cite', RENDER-MODE is `display' or `sort'. - If the optional INTERNAL-LINKS is `bib-links' then link cites -to the bibliography regardless of the style type, if `no-links' -then don't add internal links, if nil or `auto' then add internal -links based on the style type (cite-cite links for note styles -and cite-bib links else). For legacy reasons, any other value is -treated as `no-links'. - If the optional NO-EXTERNAL-LINKS is non-nil then don't add -external links." - (-if-let (unprocessed-id (alist-get 'unprocessed-with-id var-alist)) - ;; Itemid received no associated csl fields from the getter! - (list nil (concat "NO_ITEM_DATA:" unprocessed-id)) - (let* ((context (citeproc-context-create var-alist style mode render-mode - no-external-links)) - (layout-fun-accessor (if (eq mode 'cite) 'citeproc-style-cite-layout - 'citeproc-style-bib-layout)) - (layout-fun (funcall layout-fun-accessor style))) - (if (null layout-fun) "[NO BIBLIOGRAPHY LAYOUT IN CSL STYLE]" - (let ((rendered (catch 'stop-rendering - (funcall layout-fun context)))) - ;; Finalize external linking by linking the title if needed - (when (and (eq mode 'bib) (not no-external-links)) - (-when-let ((var . val) (--any (assoc it var-alist) - citeproc--linked-vars)) - (unless (cl-intersection (citeproc-rt-rendered-vars rendered) - citeproc--linked-vars) - (citeproc-rt-link-title rendered - (concat (alist-get var citeproc--link-prefix-alist - "") - (alist-get var var-alist)))))) - ;; Add appropriate item-no information - (when-let* ((cite-no-attr - (citeproc-context-int-link-attrval - style internal-links mode (alist-get 'position var-alist))) - (cite-no-attr-val (cons cite-no-attr - (alist-get 'citation-number var-alist)))) - (cond ((consp rendered) (setf (car rendered) - (-snoc (car rendered) cite-no-attr-val))) - ((stringp rendered) (setq rendered - (list (list cite-no-attr-val) rendered))))) - ;; Add year-suffix if needed - (-if-let (year-suffix (alist-get 'year-suffix var-alist)) - (car (citeproc-rt-add-year-suffix - rendered - ;; year suffix is empty if already rendered by var just to delete the - ;; suppressed date - (if (citeproc-style-uses-ys-var style) "" year-suffix))) - rendered)))))) - -(provide 'citeproc-context) - -;;; citeproc-context.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-date.el b/elpa/citeproc-20230228.1414/citeproc-date.el deleted file mode 100644 index abf166f8..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-date.el +++ /dev/null @@ -1,280 +0,0 @@ -;;; citeproc-date.el --- CSL date rendering -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Structure type and functions to render CSL date elements. - -;;; Code: - -(require 'subr-x) -(require 'cl-lib) -(require 'dash) -(require 'let-alist) -(require 's) - -(require 'citeproc-lib) -(require 'citeproc-rt) -(require 'citeproc-context) - -(cl-defstruct (citeproc-date (:constructor citeproc-date-create)) - "Struct for representing dates. -Slots YEAR, MONTH, DAY are integers, while SEASON and CIRCA are -booleans. SEASON indicates whether the integer in slot MONTH is -to be interpreted as a season number." - (year nil) (month nil) (day nil) (season nil) (circa nil)) - -(defun citeproc-date-parse (date-rep) - "Parse CSL json date repr. DATE-REP into an internal one." - (let-alist date-rep - (--map (citeproc-date--conv it .season .circa) .date-parts))) - -(defun citeproc-date--conv (dates &optional season circa) - "Convert date-part list DATES to a citeproc-date struct. -Set the remaining slots to the values SEASON and CIRCA." - (-let* ((numeric - (--map (if (stringp it) (string-to-number it) it) dates)) - ((year month day) numeric)) - (citeproc-date-create :year year :month month :day day - :season season :circa circa))) - -(defun citeproc-date--partattrs-for-sort (part-attrs) - "Return a sort-key version of PART-ATTRS." - (let (result) - (when (assoc 'day part-attrs) - (push '(day . ((form . "numeric-leading-zeros"))) result)) - (when (assoc 'month part-attrs) - (push '(month . ((form . "numeric-leading-zeros"))) result)) - (when (assoc 'year part-attrs) - (push '(year . ((form . "long"))) result)) - result)) - -(defun citeproc--date (attrs context &rest body) - "Function corresponding to the date CSL element." - (-let* (((&alist 'variable var - 'form form) - attrs) - (var-sym (intern var)) - (parsed-dates (citeproc-var-value var-sym context)) - ((d1 d2) parsed-dates) - (result - (if d1 - (progn - (when form - (let ((localized (citeproc-date--localized-attrs attrs body context))) - (setq attrs (car localized) - body (cdr localized)))) - (when (eq (citeproc-context-render-mode context) 'sort) - (setq body (citeproc-date--partattrs-for-sort body))) - (if (citeproc-date--renders-with-attrs-p d1 body) - (progn - (push `(rendered-var . ,(intern var)) attrs) - (cons (if d2 - (citeproc-date--render-range d1 d2 attrs body context) - (citeproc-date--render d1 attrs body context)) - 'present-var)) - (cons nil 'empty-vars))) - (cons nil 'empty-vars)))) - ;; Handle `year' citation mode by stopping if needed - (citeproc-lib-maybe-stop-rendering 'issued context result var-sym))) - -(defun citeproc--date-part (attrs _context &rest _body) - "Function corresponding to the date-part CSL element." - (cons (intern (alist-get 'name attrs)) - attrs)) - -(defun citeproc-date--renders-with-attrs-p (date part-attrs) - "Whether DATE contains date-parts corresponding to PART-ATTRS." - (let ((date-parts (mapcar #'car part-attrs))) - (or (memq 'year date-parts) ; All dates contain a year - (and (memq 'month date-parts) (citeproc-date-month date)) - (and (memq 'day date-parts) (citeproc-date-day date))))) - -(defun citeproc-date--localized-attrs (attrs part-attrs context) - "Return the localized date attrs merged with date ATTRS and date PART-ATTRS." - (-let* (((&alist 'form form - 'date-parts date-parts) - attrs) - ((loc-attrs . loc-part-attrs) - (if (string= form "text") (citeproc-context-date-text context) - (citeproc-context-date-numeric context)))) - (pcase (citeproc-lib-intern date-parts) - ('year - (setq loc-part-attrs - (--select (eq (car it) 'year) loc-part-attrs))) - ('year-month - (setq loc-part-attrs - (--select (memq (car it) '(year month)) loc-part-attrs)))) - (cons (-concat attrs loc-attrs) - (--map (cons (car it) - (-concat (alist-get (car it) part-attrs) (cdr it))) - loc-part-attrs)))) - -(defun citeproc-date--render (d attrs part-attrs context) - "Render citeproc-date D according to formatting in ATTRS and PART-ATTRS. -Return a rich-text content." - (if (citeproc-var-value 'suppress-date context) - (citeproc-rt-format-single attrs "" context) - (let ((rendered-date (citeproc-date--render-parts d part-attrs context))) - (citeproc-rt-join-formatted attrs rendered-date context)))) - -(defun citeproc-date--render-parts (d part-attrs context &optional no-last-suffix) - "Render the parts of citeproc-date D according to PART-ATTRS. -Return a list of rich-text contents. If optional NO-LAST-SUFFIX -is non-nil then remove the suffix attribute of the last rendered -element (used for date range rendering)." - (let ((result (--map (pcase (car it) - ('year (citeproc-date--render-year d (cdr it) context)) - ('month (citeproc-date--render-month d (cdr it) context)) - ('day (citeproc-date--render-day d (cdr it) context))) - part-attrs))) - (-if-let* ((n-l-s no-last-suffix) - (last (car (last result))) - (wo-suffix (and (consp last) - (cons (--remove (eq 'suffix (car it)) (car last)) - (cdr last))))) - (-snoc (butlast result) wo-suffix) - result))) - -(defun citeproc-date--render-range-parts (d1 d2 part-attrs sep context) - "Render the parts of citeproc-dates D1 and D2 according to PART-ATTRS. -PART-ATTRS is a list containing either part-attrs or lists of part-attrs. -The formers are only rendered for D1, while the latters are rendered for both -D1 and D2. Return a list of rich-text contents." - (--mapcat (pcase (car it) - ('year (list (citeproc-date--render-year d1 (cdr it) context))) - ('month (list (citeproc-date--render-month d1 (cdr it) context))) - ('day (list (citeproc-date--render-day d1 (cdr it) context))) - (_ (-concat (citeproc-date--render-parts d1 it context t) - (list sep) - (citeproc-date--render-parts d2 it context)))) - part-attrs)) - -(defun citeproc-date--render-range (d1 d2 attrs part-attrs context) - "Render the range given by dates D1 D2 according to attrs." - (if (citeproc-var-value 'suppress-date context) - (citeproc-rt-format-single attrs "" context) - (let* ((gran (min (citeproc-date--gran d1) - (citeproc-date--attrs-gran part-attrs))) - (range-sep (or (alist-get 'range-delimiter - (alist-get (elt '(year month day) gran) - part-attrs)) - "–")) - (range-p-attrs - (cond ((/= (citeproc-date-year d1) (citeproc-date-year d2)) - (list part-attrs)) - ((/= (citeproc-date-month d1) (citeproc-date-month d2)) - (let ((year-part (--find (eq 'year (car it)) - part-attrs)) - (attrs-wo-year - (--remove (eq 'year (car it)) - part-attrs))) - (cond ((eq (caar part-attrs) 'year) - (list year-part attrs-wo-year)) - ((eq (caar (last part-attrs)) 'year) - (list attrs-wo-year year-part)) - (t (list attrs-wo-year))))) - (t (--map (if (eq (car it) 'day) (list it) it) - part-attrs)))) - (rendered-range (citeproc-date--render-range-parts d1 d2 range-p-attrs range-sep - context))) - (citeproc-rt-join-formatted attrs rendered-range context)))) - -(defun citeproc-date--attrs-gran (d-attrs) - "Return the granularity (smallest unit) of date-attrs alist D-ATTRS. -The returned value is 0, 1 or 2, corresponding to a year, month -or day granularity." - (cond ((assoc 'day d-attrs) 2) - ((assoc 'month d-attrs) 1) - (t 0))) - -(defun citeproc-date--gran (date) - "Return the granularity (smallest unit) in citeproc-date struct DATE. -The returned value is 0, 1 or 2, corresponding to a year, month -or day granularity." - (cond ((citeproc-date-day date) 2) - ((citeproc-date-month date) 1) - (t 0))) - -(defun citeproc-date--render-year (d attrs context) - "Render the year in date D according to formatting in ATTRS. -D is a citeproc-date structure. Return a rich-text content." - (-let* ((form (alist-get 'form attrs)) - (year (citeproc-date-year d)) - (s (number-to-string (abs year))) - (era - (cond ((> year 999) "") - ((> year 0) (citeproc-term-get-text "ad" context)) - (t (citeproc-term-get-text "bc" context))))) - - (citeproc-rt-format-single attrs (concat (if (string= form "short") - (s-right 2 s) - s) - era) - context))) - -(defun citeproc-date--render-month (d attrs context) - "Render the month in date D according to formatting in ATTRS. -D is a citeproc-date structure. Return a rich-text content." - (-if-let (month (citeproc-date-month d)) - (let ((form (alist-get 'form attrs)) - (term-pref (if (citeproc-date-season d) - "season-" "month-"))) - (citeproc-rt-format-single - attrs - (pcase (citeproc-lib-intern form) - ('numeric (number-to-string month)) - ('numeric-leading-zeros (format "%02d" month)) - ('short (citeproc-term-inflected-text - (concat term-pref (format "%02d" month)) - 'short nil context)) - (_ (citeproc-term-inflected-text - (concat term-pref (format "%02d" month)) - 'long nil context))) - context)) - nil)) - -(defun citeproc-date--render-day (d attrs context) - "Render the day in date D according to formatting in ATTRS. -D is a citeproc-date structure. Return a rich-text content." - (-if-let (day (citeproc-date-day d)) - (let ((form (alist-get 'form attrs)) - (month (citeproc-date-month d))) - (citeproc-rt-format-single - attrs - (cond - ((string= form "numeric-leading-zeros") - (format "%02d" day)) - ((and (string= form "ordinal") - (or (= day 1) - (not (string= "true" - (alist-get 'limit-day-ordinals-to-day-1 - (citeproc-context-locale-opts context)))))) - (citeproc-number--format-as-ordinal (number-to-string day) - (concat "month-" (format "%02d" month)) - context)) - (t (number-to-string day))) - context)) - nil)) - -(provide 'citeproc-date) - -;;; citeproc-date.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-disamb.el b/elpa/citeproc-20230228.1414/citeproc-disamb.el deleted file mode 100644 index 0f585105..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-disamb.el +++ /dev/null @@ -1,247 +0,0 @@ -;;; citeproc-disamb.el --- disambiguate ambiguous cites -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to disambiguate cites of different bibliography items that would -;; have the same rendering. Disambiguation steps (e.g., adding more names, -;; expanding names, adding year-suffixes) are performed according to the -;; disambiguation rules specified by the CSL style in use. - -;;; Code: - -(require 'dash) -(require 'cl-lib) -(require 'subr-x) - -(require 'citeproc-itemdata) - -(defun citeproc-itd-inc-disamb-level (key itd type) - "Increment the disambiguation level of KEY in itemdata ITD. -TYPE is either `add-names' or `show-given-names.'" - (let ((vv (citeproc-itemdata-varvals itd))) - (if (alist-get type vv) - (let* ((cur-level (alist-get key (alist-get type vv))) - (new-level (if cur-level (1+ cur-level) 1))) - (setf (alist-get key (alist-get type vv)) new-level)) - (push `(,type . ((,key . 1))) (citeproc-itemdata-varvals itd)))) - (setf (citeproc-itemdata-rc-uptodate itd) nil)) - -(defun citeproc-itd-add-name (itd style &optional _first-step) - "Perform an add-name disambig. step on itemdata ITD with STYLE. -FIRST-STEP is ignored -- it is there to get the same signature as -the other two disamb. step functions. Return nil if no disambiguation -could be performed and t otherwise. Disambiguation is performed -from left to right: an item is attempted to be expanded only if -no previous items to the left could be." - (let* ((vars (citeproc-itd-namevars itd style)) - (cite (citeproc-itd-plain-cite itd style)) - (vv (citeproc-itemdata-varvals itd)) - (levels (alist-get 'add-names vv)) - (remaining-vars (if levels (memq (caar levels) vars) vars)) - (success nil)) - (while (and (not success) remaining-vars) - (citeproc-itd-inc-disamb-level (car remaining-vars) itd 'add-names) - (if (string= cite (citeproc-itd-plain-cite itd style)) - (pop remaining-vars) - (setq success t))) - success)) - -(defun citeproc-itd-add-given (itd style &optional first-step) - "Perform an add-given disambig. step on itemdata ITD with STYLE. -Unless FIRST-STEP is non-nil, remove the last previously added -given name if the last added given name is shown in its entirety. -Return nil if no disambig. step could be performed and t -otherwise." - (let* ((nids (citeproc-itd-nameids itd style)) - (cite (citeproc-itd-plain-cite itd style)) - (vv (citeproc-itemdata-varvals itd)) - (levels (alist-get 'show-given-names vv)) - (remaining-nids (if levels (memq (caar levels) nids) nids)) - (success nil)) - (while (and (not success) remaining-nids) - (let* ((current-nid (car remaining-nids)) - (vv (citeproc-itemdata-varvals itd)) - (levels (alist-get 'show-given-names vv)) - (current-level (alist-get current-nid levels))) - (if (and current-level (>= current-level 2)) - (pop remaining-nids) - (citeproc-itd-inc-disamb-level current-nid itd 'show-given-names) - (unless (string= cite (citeproc-itd-plain-cite itd style)) - (setq success t) - (unless (or first-step current-level) - (let ((ls (alist-get 'show-given-names vv))) - (setf (alist-get 'show-given-names vv) - (cons (car ls) (cddr ls)))) - (setf (citeproc-itemdata-rc-uptodate itd) nil)))))) - success)) - -(defun citeproc-itd-addgiven-with-addname (itd style &optional first-step) - "Perform a combined disambig. step on itemdata ITD with STYLE. -If FIRST-STEP is non-nil then (i) add a new name even if the last -add-given step showed only initials, (ii) don't remove the -previously added given name. Return nil if no disambig. step -could be performed and t otherwise." - (let* ((vv (citeproc-itemdata-varvals itd)) - (gn (alist-get 'show-given-names vv)) - (success nil) - (remaining-names t)) - (if (and (not first-step) gn (= 1 (cdar gn)) (citeproc-itd-add-given itd style)) - t - (while (and (not success) remaining-names) - (let ((nids (citeproc-itd-nameids itd style))) - (if (citeproc-itd-add-name itd style) - (let* ((new-nids (citeproc-itd-nameids itd style)) - (new-nid (car (cl-set-difference new-nids nids)))) - ;;next sexp is to direct the add-given function to the just added name - (when first-step - (setf (alist-get new-nid - (alist-get 'show-given-names - (citeproc-itemdata-varvals itd))) - 0)) - (when (citeproc-itd-add-given itd style first-step) - (setq success t))) - (setq remaining-names nil)))) - success))) - -(defun citeproc-disamb--different-cites-p (itds style) - "Whether some itemdata in ITDS have different cites with STYLE." - (--any-p (not (string= (citeproc-itd-plain-cite it style) - (citeproc-itd-plain-cite (car itds) style))) - (cdr itds))) - -(defun citeproc-disamb--with-method (itds style disamb-fun) - "Disambiguate itemdatas in ITDS for STYLE with DISAMB-FUN. -Return t if the disambiguation was (at least partially) -successful and nil otherwise." - (let ((orig-settings (copy-tree (citeproc-disamb--settings itds))) - success - (first-step t)) - (while (and (not success) - (--all-p (funcall disamb-fun it style first-step) itds)) - (setq first-step nil) - (when (citeproc-disamb--different-cites-p itds style) - (setq success t))) - (unless success - (citeproc-disamb--restore-settings itds orig-settings)) - success)) - -(defun citeproc-disamb--settings (itds) - "Return a list with the disamb settings of ITDS." - (--map (cons (citeproc-itd-getvar it 'add-names) - (citeproc-itd-getvar it 'show-given-names)) - itds)) - -(defun citeproc-disamb--restore-settings (itds settings) - "Restore the disamb settings of ITDS from SETTINGS. -SETTINGS should have the structure produced by citeproc--disamb-settings." - (cl-loop for itd in itds - for (add-names-val . show-given-val) in settings do - (citeproc-itd-setvar itd 'add-names add-names-val) - (citeproc-itd-setvar itd 'show-given-names show-given-val))) - -(defun citeproc-disamb--num-to-yearsuffix (n) - "Return year-suffix no. N (starting from 0)." - (cond ((< n 26) - (char-to-string (+ 97 n))) - ((< n 702) - (let* ((rem (% n 26)) - (d (/ (- n rem) 26))) - (concat (char-to-string (+ 96 d)) - (char-to-string (+ 97 rem))))) - (t (error "Number too large to convert into a year-suffix")))) - -(defun citeproc-disamb--add-yearsuffix (itds _style) - "Disambiguate itemdata in ITDS by adding year suffices. -Return t (for the sake of consistency with other disamb methods)." - (--each-indexed (--sort (< (string-to-number (citeproc-itd-getvar it 'citation-number)) - (string-to-number (citeproc-itd-getvar other 'citation-number))) - itds) - (citeproc-itd-setvar it 'year-suffix (citeproc-disamb--num-to-yearsuffix it-index)) - (setf (citeproc-itemdata-rc-uptodate it) nil)) - t) - -(defun citeproc-disamb--set-fields (itds) - "Disambiguate ITDS by setting their disambiguate fields." - (--each itds - (citeproc-itd-setvar it 'disambiguate t))) - -(defun citeproc-disamb-amb-itds (itds style name given yearsuff) - "Disambiguate ITDS ambigous for STYLE with the given methods. -NAME, GIVEN and YEARSUFF are generalized booleans specifying -whether or not the add-name, show-given or add-year-suffix -disambiguation methods should be used. Return t if the -disambiguation was (at least partially) successful, nil -otherwise." - (or (and name (citeproc-disamb--with-method itds style 'citeproc-itd-add-name)) - (and given (citeproc-disamb--with-method itds style 'citeproc-itd-add-given)) - (and name given - (citeproc-disamb--with-method itds style 'citeproc-itd-addgiven-with-addname)) - (progn - (citeproc-disamb--set-fields itds) - (citeproc-disamb--different-cites-p itds style)) - (and yearsuff - (citeproc-disamb--add-yearsuffix itds style) - (citeproc-disamb--different-cites-p itds style)))) - -(defun citeproc-amb-itds (itds style) - "Return a list of ambigous sets in ITDS for STYLE. -The returned value is a (possibly empty) list of lists." - (let* ((sorted (-sort (lambda (x y) - (string< (citeproc-itd-plain-cite x style) - (citeproc-itd-plain-cite y style))) - itds)) - (result nil) - (remaining (cdr sorted)) - (act (car sorted)) - (act-list (list act)) - (ambig nil)) - (while remaining - (let ((next (car remaining))) - (if (string= (citeproc-itd-plain-cite act style) - (citeproc-itd-plain-cite next style)) - (progn - (push next act-list) - (setq ambig t)) - (when ambig (push act-list result)) - (setq act-list (list next) - act next - ambig nil)) - (pop remaining))) - (when ambig (push act-list result)) - result)) - -(defun citeproc-disamb-itds (itds style name given yearsuff) - "Disambiguate itemdatas in list ITDS for STYLE. -NAME, GIVEN and YEARSUFF are generalized booleans specifying -whether or not the add-name, show-given or add-year-suffix -disambiguation methods should be used." - (let ((amb-itds (citeproc-amb-itds itds style))) - (while amb-itds - (let ((act-set (pop amb-itds))) - (citeproc-disamb-amb-itds act-set style name given yearsuff) - (when (citeproc-disamb--different-cites-p act-set style) - (-when-let (new-ambs (citeproc-amb-itds act-set style)) - (setq amb-itds (nconc new-ambs amb-itds)))))))) - -(provide 'citeproc-disamb) - -;;; citeproc-disamb.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-formatters.el b/elpa/citeproc-20230228.1414/citeproc-formatters.el deleted file mode 100644 index 5897b26c..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-formatters.el +++ /dev/null @@ -1,392 +0,0 @@ -;; citeproc-formatters.el --- output formatters -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides a general framework for defining citeproc-el output formatters, and, -;; using this framework, defines formatters for the formats `raw' (the rich-text -;; internal representation), `plain' (plain-text), `html', `org' and `latex'. -;; Further output formatters can easily be added. - -;;; Code: - -(require 'let-alist) -(require 'subr-x) -(require 's) -(require 'cl-lib) - - (cl-defstruct (citeproc-formatter (:constructor citeproc-formatter-create)) - "Output formatter struct with slots RT, CITE, BIB-ITEM and BIB. -RT is a one-argument function mapping a rich-text to its - formatted version, -CITE is a one-argument function mapping the output of RT for a - citation rich-text to a fully formatted citation, -BIB-ITEM is a two-argument function mapping the output of RT for - a bibliography-item rich-text and a BIB-FORMAT alist (see - below) to a fully formatted bibliography item, -BIB is a two-argument function mapping a list of formatted - bibliography items and a FORMATTING-PARAMETERS alist (see - `citeproc-render-bib' for details) to a fully formatted - bibliography, -NO-EXTERNAL-LINKS is non-nil if the formatter doesn't support - external linking." - rt (cite #'identity) (bib-item (lambda (x _) x)) - (bib (lambda (x _) (mapconcat #'identity x "\n\n"))) - (no-external-links nil)) - -(defun citeproc-formatter-fun-create (fmt-alist) - "Return a rich-text formatter function based on FMT-ALIST. -FMT-ALIST is an alist with some or all of the following symbols -as keys: -- `unformatted', -- `font-style-italic', `font-style-oblique', `font-style-normal', -- `font-variant-small-caps', `font-variant-normal', -- `font-weight-bold', `font-weight-light', `font-weight-normal', -- `text-decoration-underline', `text-decoration-normal', -- `vertical-align-sub', `vertical-align-sup', `vertical-align-baseline', -- `display-block', `display-left-margin', `display-right-inline', - `display-indent', -- `href', -- `cited-item-no', `bib-item-no'. - -With the exceptions listed below the values should be -one-argument formatting functions that format the input string -according to the attribute-value pair specified by the key. - -The exceptions are the keys -`unformatted', for which the value should be a one-argument - function converting unformatted text into the required - format (e.g., by escaping); -`href', here the value should be a two-argument function - mapping the first argument as anchor text and the second as - target URI to a hyperlink representation; and -`cited-item-no' and `bib-item-no' whose associated values - should be two-argument functions, which are called with the - already formatted cites/bibliography item text and the number of - the bibliography item as a string." - (cl-labels - ((rt-fmt - (rt) - (pcase rt - ((pred stringp) (funcall (alist-get 'unformatted fmt-alist) rt)) - ((pred consp) - (let ((attrs (car rt)) - (result (mapconcat #'rt-fmt (cdr rt) ""))) - (dolist (attr attrs) - (let ((key (car attr))) - (if (memq key '(href cited-item-no bib-item-no)) - (when-let ((fmt-fun (alist-get key fmt-alist))) - (setq result (funcall fmt-fun result (cdr attr)))) - (when-let - ((fmt-fun - (alist-get - (pcase attr - ('(font-style . "italic") 'font-style-italic) - ('(font-weight . "bold") 'font-weight-bold) - ('(display . "indent") 'display-indent) - ('(display . "left-margin") 'display-left-margin) - ('(display . "right-inline") 'display-right-inline) - ('(display . "block") 'display-block) - ('(vertical-align . "sup") 'vertical-align-sup) - ('(vertical-align . "baseline") 'vertical-align-baseline) - ('(font-variant . "small-caps") 'font-variant-small-caps) - ('(text-decoration . "underline") 'text-decoration-underline) - ('(font-style . "oblique") 'font-style-oblique) - ('(font-style . "normal") 'font-style-normal) - ('(font-variant . "normal") 'font-variant-normal) - ('(font-weight . "light") 'font-weight-light) - ('(font-weight . "normal") 'font-weight-normal) - ('(text-decoration . "normal") 'text-decoration-normal) - ('(vertical-align . "sub") 'vertical-align-sub)) - fmt-alist))) - (setq result (funcall fmt-fun result)))))) - result)) - (_ rt)))) - #'rt-fmt)) - -;;;; Specific formatters - -;; Org - -(defun citeproc-fmt--org-link (anchor target) - "Return an Org link with ANCHOR and TARGET. -If ANCHOR is string= to TARGET then return ANCHOR." - (if (string= anchor target) - anchor - (concat "[[" target "][" anchor "]]"))) - -(defconst citeproc-fmt--org-alist - `((unformatted . identity) - (href . ,#'citeproc-fmt--org-link) - (cited-item-no . ,(lambda (x y) (concat "[[citeproc_bib_item_" y "][" x "]]"))) - (bib-item-no . ,(lambda (x y) (concat "<>" x))) - ;; Warning: The next four formatter lines put protective zero-width spaces - ;; around the Org format characters ('/' etc.). - (font-style-italic . ,(lambda (x) (concat "​/" x "/​"))) - (font-style-oblique . ,(lambda (x) (concat "​/" x "/​"))) - (font-weight-bold . ,(lambda (x) (concat "​*" x "*​"))) - (text-decoration-underline . ,(lambda (x) (concat "​_" x "_​"))) - ;; End of zero-width space protected formatters. - (font-variant-small-caps . ,(lambda (x) (upcase x))) - (vertical-align-sub . ,(lambda (x) (concat "_{" x "}"))) - (vertical-align-sup . ,(lambda (x) (concat "^{" x "}"))) - (display-left-margin . ,(lambda (x) (concat x " "))))) - -(defvar citeproc-fmt--org-format-rt-1 - (citeproc-formatter-fun-create citeproc-fmt--org-alist) - "Recursive rich-text Org formatter. -Doesn't do finalization by removing zero-width spaces.") - -(defun citeproc-fmt--org-format-rt (rt) - "Convert rich-text RT into Org format. -Performs finalization by removing unnecessary zero-width spaces." - (let ((result (funcall citeproc-fmt--org-format-rt-1 rt))) - (when (> (length result) 2) - ;; First we remove z-w spaces around spaces and before punctuation. - (setq result (citeproc-s-replace-all-seq - result '((" ​" . " ") ("​ " . " ") ("​," . ",") ("​;" . ";") - ("​:" . ":") ("​." . ".")))) - ;; Starting and ending z-w spaces are also removed, but not before an - ;; asterisk to avoid creating an Org heading. - (when (and (= (aref result 0) 8203) - (not (= (aref result 1) ?*))) - (setq result (substring result 1))) - (when (= (aref result (- (length result) 1)) 8203) - (setq result (substring result 0 -1)))) - result)) - -;; HTML - -(defun citeproc-fmt--xml-escape (s) - "Return the xml-escaped version of string S. -Only '&', '<' and '>' are escaped to keep compatibility with the -CSL tests." - (citeproc-s-replace-all-seq s '(("&" . "&") ("<" . "<") (">" . ">")))) - -(defconst citeproc-fmt--html-alist - `((unformatted . citeproc-fmt--xml-escape) - (href . ,(lambda (x y) (concat "" x ""))) - (cited-item-no . ,(lambda (x y) (concat "" - x ""))) - (bib-item-no . ,(lambda (x y) (concat "" - x))) - (font-style-italic . ,(lambda (x) (concat "" x ""))) - (font-style-oblique . ,(lambda (x) - (concat ""))) - (font-variant-small-caps . ,(lambda (x) - (concat - "" x ""))) - (font-weight-bold . ,(lambda (x) (concat "" x ""))) - (text-decoration-underline . - ,(lambda (x) - (concat - "" x ""))) - (vertical-align-sub . ,(lambda (x) (concat "" x ""))) - (vertical-align-sup . ,(lambda (x) (concat "" x ""))) - (vertical-align-baseline . ,(lambda (x) (concat "" x ""))) - (display-left-margin . ,(lambda (x) (concat "\n
" - x "
"))) - (display-right-inline . ,(lambda (x) (concat "
" - x "
\n "))) - (display-block . ,(lambda (x) (concat "\n\n
" - x "
\n"))) - (display-indent . ,(lambda (x) (concat "
" x "
\n "))))) - -(defconst citeproc-fmt--csl-test-alist - `((unformatted . citeproc-fmt--xml-escape) - (cited-item-no . ,(lambda (x y) (concat "" - x ""))) - (bib-item-no . ,(lambda (x y) (concat "" - x))) - (font-style-italic . ,(lambda (x) (concat "" x ""))) - (font-style-oblique . ,(lambda (x) - (concat ""))) - (font-variant-small-caps . ,(lambda (x) - (concat - "" x ""))) - (font-weight-bold . ,(lambda (x) (concat "" x ""))) - (text-decoration-underline . - ,(lambda (x) - (concat - "" x ""))) - (vertical-align-sub . ,(lambda (x) (concat "" x ""))) - (vertical-align-sup . ,(lambda (x) (concat "" x ""))) - (vertical-align-baseline . ,(lambda (x) (concat "" x ""))) - (display-left-margin . ,(lambda (x) (concat "\n
" - x "
"))) - (display-right-inline . ,(lambda (x) (concat "
" - x "
\n "))) - (display-block . ,(lambda (x) (concat "\n\n
" - x "
\n"))) - (display-indent . ,(lambda (x) (concat "
" x "
\n "))))) - -(defun citeproc-fmt--html-bib-formatter (items _bib-format) - "Return a html bibliography from already formatted ITEMS." - (concat "
\n" - (mapconcat (lambda (i) - (concat "
" i "
\n")) - items - "") - "
")) - -;; LaTeX - -(defconst citeproc-fmt--latex-esc-regex - (regexp-opt '("_" "&" "#" "%" "$")) - "Regular expression matching characters to be escaped in LaTeX output.") - -(defun citeproc-fmt--latex-escape (s) - "Return the LaTeX-escaped version of string S." - (replace-regexp-in-string citeproc-fmt--latex-esc-regex "\\\\\\&" s)) - -(defun citeproc-fmt--latex-href (text uri) - (let ((escaped-uri (replace-regexp-in-string "%" "\\\\%" uri))) - (if (string-prefix-p "http" text) - (concat "\\url{" escaped-uri "}") - (concat "\\href{" escaped-uri "}{" text "}")))) - -(defconst citeproc-fmt--latex-alist - `((unformatted . ,#'citeproc-fmt--latex-escape) - (href . ,#'citeproc-fmt--latex-href) - (font-style-italic . ,(lambda (x) (concat "\\textit{" x "}"))) - (font-weight-bold . ,(lambda (x) (concat "\\textbf{" x "}"))) - (cited-item-no . ,(lambda (x y) (concat "\\citeprocitem{" y "}{" x "}"))) - (bib-item-no . ,(lambda (x y) (concat "\\hypertarget{citeproc_bib_item_" y "}{" - x "}"))) - (font-variant-small-caps . ,(lambda (x) (concat "\\textsc{" x "}"))) - (text-decoration-underline . ,(lambda (x) (concat "\\underline{" x "}"))) - (vertical-align-sup . ,(lambda (x) (concat "\\textsuperscript{" x "}"))) - (display-left-margin . ,(lambda (x) (concat x " "))) - (vertical-align-sub . ,(lambda (x) (concat "\\textsubscript{" x "}"))) - (font-style-oblique . ,(lambda (x) (concat "\\textsl{" x "}"))))) - -;; Org-LaTeX - -(defconst citeproc-fmt--org-latex-alist - `((unformatted . ,#'citeproc-fmt--latex-escape) - (href . ,#'citeproc-fmt--latex-href) - (font-style-italic . ,(lambda (x) (concat "\\textit{" x "}"))) - (font-weight-bold . ,(lambda (x) (concat "\\textbf{" x "}"))) - (cited-item-no . ,(lambda (x y) (concat "\\cslcitation{" y "}{" x "}"))) - (bib-item-no . ,(lambda (x y) (concat "\\cslbibitem{" y "}{" x "}"))) - (font-variant-small-caps . ,(lambda (x) (concat "\\textsc{" x "}"))) - (text-decoration-underline . ,(lambda (x) (concat "\\underline{" x "}"))) - (vertical-align-sup . ,(lambda (x) (concat "\\textsuperscript{" x "}"))) - (display-left-margin . ,(lambda (x) (concat "\\cslleftmargin{" x "}"))) - (display-right-inline . ,(lambda (x) (concat "\\cslrightinline{" x "}"))) - (display-block . ,(lambda (x) (concat "\\cslblock{" x "}"))) - (display-indent . ,(lambda (x) (concat "\\cslindent{" x "}"))) - (vertical-align-sub . ,(lambda (x) (concat "\\textsubscript{" x "}"))) - (font-style-oblique . ,(lambda (x) (concat "\\textsl{" x "}"))))) - -(defun citeproc-fmt--org-latex-bib-formatter (items bib-format) - "Return an Org LaTeX bibliography of ITEMS formatted in BIB-FORMAT." - (let-alist bib-format - (let ((hanging-indent (if .hanging-indent "1" "0")) - (entry-spacing (if (and .entry-spacing (<= 1 .entry-spacing)) - (number-to-string (- .entry-spacing 1)) - "0"))) - (concat "\\begin{cslbibliography}{" hanging-indent "}{" entry-spacing "}\n" - (mapconcat #'identity items "\n\n") - "\n\n\\end{cslbibliography}\n")))) - -;; Org-ODT - -(defconst citeproc-fmt--org-odt-alist - `((unformatted . citeproc-fmt--xml-escape) - (href . ,(lambda (x y) (concat "" x ""))) - (cited-item-no - . ,(lambda (x y) (concat "" x ""))) - (bib-item-no - . ,(lambda (x y) - (concat "" - "" - "" x))) - (font-style-italic - . ,(lambda (x) (concat "" x ""))) - (font-style-oblique - . ,(lambda (x) (concat "" x ""))) - ;; NOTE: small caps support requires the availability of the OrgSmallcaps ODT style - ;; this requires an addition to or replacement of the default OrgOdtStyles.xml - (font-variant-small-caps - . ,(lambda (x) (concat "" x ""))) - (font-weight-bold - . ,(lambda (x) (concat "" x ""))) - (text-decoration-underline - . ,(lambda (x) (concat "" x ""))) - (vertical-align-sub - . ,(lambda (x) (concat "" x ""))) - (vertical-align-sup - . ,(lambda (x) - (concat "" x ""))) - ;; TODO: - ;; - display-left-margin - ;; - display-right-inline - ;; - display-block - ;; - display-indent - )) - -(defun citeproc-fmt--org-odt-bib-formatter (items _bib-format) - "Return a html bibliography from already formatted ITEMS." - (mapconcat (lambda (i) - (concat "" i "")) - items - "\n")) - -;; Define the formatters alist - -(defvar citeproc-fmt--formatters-alist - `((org-odt . ,(citeproc-formatter-create - :rt (citeproc-formatter-fun-create citeproc-fmt--org-odt-alist) - :bib #'citeproc-fmt--org-odt-bib-formatter - )) - (html . ,(citeproc-formatter-create - :rt (citeproc-formatter-fun-create citeproc-fmt--html-alist) - :bib #'citeproc-fmt--html-bib-formatter)) - (csl-test . ,(citeproc-formatter-create - :rt (citeproc-formatter-fun-create citeproc-fmt--csl-test-alist) - :bib #'citeproc-fmt--html-bib-formatter - :no-external-links t)) - (raw . ,(citeproc-formatter-create :rt #'identity :bib (lambda (x _) x))) - (org . ,(citeproc-formatter-create :rt #'citeproc-fmt--org-format-rt)) - (org-latex . ,(citeproc-formatter-create - :rt (citeproc-formatter-fun-create citeproc-fmt--org-latex-alist) - :bib #'citeproc-fmt--org-latex-bib-formatter)) - (latex . ,(citeproc-formatter-create - :rt (citeproc-formatter-fun-create citeproc-fmt--latex-alist) - :bib (lambda (x _) (concat (mapconcat #'identity x "\n\n") - "\\bigskip")))) - (plain . ,(citeproc-formatter-create :rt #'citeproc-rt-to-plain - :no-external-links t))) - "Alist mapping supported output formats to formatter structs.") - -(defun citeproc-formatter-for-format (format) - "Return the formatter struct belonging to FORMAT. -FORMAT is a symbol" - (if-let ((formatter (alist-get format citeproc-fmt--formatters-alist))) - formatter - (error "No formatter for citeproc format `%s'" format))) - -(provide 'citeproc-formatters) - -;;; citeproc-formatters.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-generic-elements.el b/elpa/citeproc-20230228.1414/citeproc-generic-elements.el deleted file mode 100644 index 2d1a3391..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-generic-elements.el +++ /dev/null @@ -1,151 +0,0 @@ -;;; citeproc-generic-elements.el --- render generic CSL elements -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions corresponding to the generic CSL rendering elements cs:layout, -;; cs:group and cs:text. With the exception of `citeproc--layout' they return a -;; (CONTENT . CONTENT-TYPE) pair, where CONTENT is the rendered rich-text output -;; and CONTENT-TYPE is one of the symbols `text-only', `empty-vars' and -;; `present-var.' In contrast, `citeproc--layout' returns only the rendered -;; rich-text content. - -;;; Code: - -(require 'dash) -(require 'let-alist) -(require 's) - -(require 'citeproc-rt) -(require 'citeproc-context) -(require 'citeproc-macro) - -(defun citeproc--layout (attrs context &rest body) - "Render the content of a layout element with ATTRS and BODY." - (let* ((attrs (if (eq (citeproc-context-mode context) 'bib) attrs - nil)) ; No attrs if mode is cite -- they are used for citations - (spliced-body (citeproc-lib-splice-into body 'splice)) - (suffix (alist-get 'suffix attrs)) - (attrs-wo-suffix (--remove (eq (car it) 'suffix) attrs)) - (rendered-body (--map (car it) spliced-body))) - ;; Handle second-field align - (when (and (alist-get 'second-field-align (citeproc-context-opts context)) - (> (length rendered-body) 1)) - (setq rendered-body `((((display . "left-margin")) ,(car rendered-body)) - (((display . "right-inline")) ,@(cdr rendered-body))))) - (let* ((affix-rendered (citeproc-rt-render-affixes - (citeproc-rt-dedup (citeproc-rt-join-formatted attrs-wo-suffix rendered-body - context)))) - (last-elt (and (listp affix-rendered) (-last-item affix-rendered))) - (last-display (and (consp last-elt) (car last-elt) - (--any-p (eq (car it) 'display) (car last-elt))))) - (when suffix - (if last-display - ;; If the last element has a display attribute then we have to append the - ;; suffix string to this last element - (setf (nth (1- (length affix-rendered)) affix-rendered) - (-snoc (-last-item affix-rendered) suffix)) - ;; Else we simply append it to the already rendered content - (setq affix-rendered (if (listp affix-rendered) - (-snoc affix-rendered suffix) - (concat affix-rendered suffix))))) - affix-rendered))) - -(defun citeproc--group (attrs context &rest body) - "Render the content of a group element with ATTRS and BODY." - (-let* ((spliced-body (citeproc-lib-splice-into body 'splice)) - (types (--map (cdr it) spliced-body)) - (type (cond ((--all? (eq it 'text-only) types) - 'text-only) - ((--any? (eq it 'present-var) types) - 'present-var) - (t 'empty-vars)))) - (cons (if (or (eq type 'text-only) - (eq type 'present-var)) - (citeproc-rt-join-formatted attrs (--map (car it) spliced-body) context) - nil) - type))) - -(defconst citeproc-generic-elements--url-prefix-re "https?://\\S *\\'" - "Regex matching an URL prefix at the end of a string.") - -(defun citeproc--text (attrs context &rest _body) - "Render the content of a text element with ATTRS and BODY." - (let-alist attrs - (let ((content nil) - (type 'text-only) - (no-external-links (citeproc-context-no-external-links context))) - (cond (.value (setq content .value)) - (.variable - (let ((val (citeproc-var-value (intern .variable) context (citeproc-lib-intern - .form)))) - (setq content val) - (cond - (val (let ((var (intern .variable))) - (setq type 'present-var) - (push `(rendered-var . ,var) attrs) - (when (and (not no-external-links) - (memq var citeproc--linked-vars)) - (let ((target - (concat - (alist-get var citeproc--link-prefix-alist - "") - content))) - (-when-let (match-pos - (and .prefix (s-matched-positions-all - citeproc-generic-elements--url-prefix-re - .prefix))) - ;; If the prefix ends with an URL then it is moved - ;; from the prefix to the rendered variable - ;; content. - (let ((start (caar match-pos))) - (setq content (concat (substring .prefix start) content)) - (push (cons 'prefix (substring .prefix 0 start)) - attrs))) - (push (cons 'href target) attrs))))) - ;; Don't report empty var for year-suffix, see issue #70. - ((not (string= .variable "year-suffix")) (setq type 'empty-vars))))) - (.term (setq .form (if .form (intern .form) 'long) - .plural (if (or (not .plural) - (string= .plural "false")) - 'single 'multiple) - content (let ((cont (citeproc-term-inflected-text - .term .form .plural context))) - ;; Annotate the 'no date' term as if it'd be - ;; the value of the 'issue' variable to - ;; handle implicit year suffix addition and - ;; suppression issues. - (if (string= .term "no date") - (progn - (setq type 'present-var) - `(((rendered-var . issued)) ,cont)) - cont)))) - (.macro (let ((macro-val (citeproc-macro-output .macro context))) - (setq content (car macro-val)) - (setq type (cdr macro-val))))) - ;; We stop if only the title had to be rendered. - (let ((result (cons (citeproc-rt-format-single attrs content context) type))) - (citeproc-lib-maybe-stop-rendering - 'title context result (or (and .variable (intern .variable)) t)))))) - -(provide 'citeproc-generic-elements) - -;;; citeproc-generic-elements.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-itemdata.el b/elpa/citeproc-20230228.1414/citeproc-itemdata.el deleted file mode 100644 index bbb62f7f..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-itemdata.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; citeproc-itemdata.el --- represent and access bibliography items -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Structure type and functions to handle data about bibliography items. - -;;; Code: - -(require 'citeproc-rt) -(require 'citeproc-context) - -(cl-defstruct (citeproc-itemdata (:constructor citeproc-itemdata-create)) - "Struct for storing bibliography item data. -VARVALS is an alist containg variable-name symbols as keys and - their values for the item as values, -RAWCITE is the cached cite of the item in internal rich-text - format, -RC-UPTODATE is t iff the RAWCITE field is up-to-date, -RAWBIBITEM is the cached bibliograhy item in internal rich-text - format. -SORT-KEY is the bibliography sort-key of the item, -OCCURRED-BEFORE is used during bibliography generation to - indicate whether the item was referred to earlier. If the first - occurrence is in a note then the actual value is the - note-number, -DISAMB-POS contains the position on which cite disambiguation is - based. Possible values are 'first, 'ibid and 'subsequent, -SUBBIB-NOS is a list of numeric indexes of sub-bibliographies - in which the item occurs, -UNCITED is t iff the item has no associated citation." - varvals rawcite rawbibitem rc-uptodate sort-key occurred-before - disamb-pos subbib-nos uncited) - -(defun citeproc-itd-getvar (itd var) - "Return itemdata ITD's value for VAR ." - (alist-get var (citeproc-itemdata-varvals itd))) - -(defun citeproc-itd-setvar (itd var val) - "Set itemdata ITD's value for VAR to VAL." - (setf (alist-get var (citeproc-itemdata-varvals itd) nil t) val - (citeproc-itemdata-rc-uptodate itd) nil)) - -(defun citeproc-itd-rt-cite (itd style) - "Return the rich-text cite of itemdata ITD using STYLE." - (if (citeproc-itemdata-rc-uptodate itd) - (citeproc-itemdata-rawcite itd) - (let ((rc (citeproc-render-varlist-in-rt - (cons (cons 'position (citeproc-itemdata-disamb-pos itd)) - (citeproc-itemdata-varvals itd)) - style - 'cite 'display 'no-links t))) - (setf (citeproc-itemdata-rawcite itd) rc - (citeproc-itemdata-rc-uptodate itd) t) - rc))) - -(defun citeproc-itd-plain-cite (itd style) - "Return the plain text cite of itemdata ITD using STYLE." - (citeproc-rt-to-plain (citeproc-itd-rt-cite itd style))) - -(defun citeproc-itd-namevars (itd style) - "Rendered namevars in the cite of itemdata ITD using STYLE." - (citeproc-rt-rendered-name-vars (citeproc-itd-rt-cite itd style))) - -(defun citeproc-itd-nameids (itd style) - "Rendered name ids in the cite of itemdata ITD using STYLE." - (citeproc-rt-rendered-name-ids (citeproc-itd-rt-cite itd style))) - -(defun citeproc-itd-update-disamb-pos (itd pos) - "Update the highest position of ITD with position POS." - (let ((old (citeproc-itemdata-disamb-pos itd))) - (unless (eq old 'subsequent) - (let ((new (pcase pos - ('first 'first) - ((or 'ibid 'ibid-with-locator) 'ibid) - (_ 'subsequent)))) - (setf (citeproc-itemdata-disamb-pos itd) - (cond ((memq old '(nil first)) new) - ((eq new 'subsequent) 'subsequent) - (t 'ibid))))))) - -(provide 'citeproc-itemdata) - -;;; citeproc-itemdata.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-itemgetters.el b/elpa/citeproc-20230228.1414/citeproc-itemgetters.el deleted file mode 100644 index 0d0a618e..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-itemgetters.el +++ /dev/null @@ -1,188 +0,0 @@ -;; citeproc-itemgetters.el --- functions for constructing itemgetters -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions for constructing various types of bibliographic itemgetter -;; functions. The returned itemgetter functions can, in turn, be used to create -;; `citeproc-style' and `citeproc-proc' structures. - -;;; Code: - -(require 'dash) -(require 'org) -;; Handle the fact that org-bibtex has been renamed to ol-bibtex -- for the time -;; being we support both feature names. -(or (require 'ol-bibtex nil t) - (require 'org-bibtex)) -(require 'json) -(require 'bibtex) -(require 'parsebib) - -(require 'citeproc-bibtex) -(require 'citeproc-biblatex) - -(defun citeproc-itemgetters--parsebib-buffer (entries strings) - "Parse a BibTeX/biblatex buffer with Parsebib." - ;; Note: this is needed to support different Parsebib versions in use. - (cond ((fboundp 'parsebib-parse-buffer) - (parsebib-parse-buffer entries strings t t)) - ((fboundp 'parsebib-parse-bib-buffer) - (parsebib-parse-bib-buffer :entries entries :strings strings - :expand-strings t :inheritance t)) - (t (error "No Parsebib buffer parsing function is available")))) - -(defun citeproc-hash-itemgetter-from-csl-json (file) - "Return a hash-based getter for csl json bibliography FILE." - (let* ((json-array-type 'list) - (json-key-type 'symbol) - (item-list (json-read-file file)) - (hash (make-hash-table :test 'equal))) - (--each item-list - (puthash (alist-get 'id it) it hash)) - (lambda (itemids) (--map (cons it (gethash it hash)) - itemids)))) - -(defun citeproc-itemgetter-from-csl-json (file) - "Return an item-getter for csl json bibliography FILE." - (lambda (itemids) - (let* ((json-array-type 'list) - (json-key-type 'symbol) - (item-list (json-read-file file)) - result) - (dolist (item item-list result) - (let ((id (alist-get 'id item))) - (when (member id itemids) - (push (cons id item) result))))))) - -(defun citeproc-itemgetter-from-bibtex (file-or-files) - "Return a getter for BibTeX bibliography FILE-OR-FILES." - (if (listp file-or-files) - (lambda (itemids) - (let (result - (remaining-ids (cl-copy-list itemids)) - (remaining-files file-or-files)) - (while (and remaining-ids remaining-files) - (let ((file (pop remaining-files))) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (bibtex-set-dialect 'BibTeX t) - (bibtex-map-entries - (lambda (key _beg _end) - (when (member key itemids) - (push (cons key (citeproc-bt-entry-to-csl (bibtex-parse-entry))) - result) - (setq remaining-ids (delete key remaining-ids)))))))) - result)) - (lambda (itemids) - (let (result) - (with-temp-buffer - (insert-file-contents file-or-files) - (goto-char (point-min)) - (bibtex-set-dialect 'BibTeX t) - (bibtex-map-entries - (lambda (key _beg _end) - (when (member key itemids) - (push (cons key (citeproc-bt-entry-to-csl (bibtex-parse-entry))) - result))))) - result)))) - -(defun citeproc-itemgetter-from-org-bibtex (file-or-files) - "Return a getter for org-bibtex bibliography FILE-OR-FILES." - (let ((files (if (listp file-or-files) - file-or-files - (list file-or-files)))) - (lambda (itemids) - (let (result) - (org-map-entries - (lambda () - (-when-let (key-w-entry (citeproc-bt-from-org-headline itemids)) - (push (cons (car key-w-entry) - (citeproc-bt-entry-to-csl (cdr key-w-entry))) - result))) - t files) - result)))) - -(defun citeproc-hash-itemgetter-from-any (file-or-files &optional no-sentcase-wo-langid) - "Return a getter for FILE-OR-FILES in any supported format. -The format is determined on the basis of file extensions. -Supported formats: -- CSL-JSON (.json extension) the recommended native format; -- BibTeX/biblatex (.bib or .bibtex extension), -- org-bibtex (.org extension). -If NO-SENTCASE-WO-LANGID is non-nil then title fields in items -without a `langid' field are not converted to sentence-case." - (let ((files (if (listp file-or-files) - file-or-files - (list file-or-files))) - (cache (make-hash-table :test #'equal)) - (bt-entries (make-hash-table :test #'equal)) - (bt-strings (make-hash-table :test #'equal))) - (dolist (file files) - (pcase (file-name-extension file) - ("json" - (let ((json-array-type 'list) - (json-key-type 'symbol)) - (dolist (item (json-read-file file)) - (puthash (cdr (assq 'id item)) item cache)))) - ((and (or "bib" "bibtex") ext) - (with-temp-buffer - (insert-file-contents file) - (bibtex-set-dialect (if (string= ext "bib") 'biblatex 'BibTeX) t) - (citeproc-itemgetters--parsebib-buffer bt-entries bt-strings))) - ("org" - (org-map-entries - (lambda () - (-when-let (key-w-entry (citeproc-bt-from-org-headline)) - (condition-case err - (puthash (car key-w-entry) (citeproc-blt-entry-to-csl - (cdr key-w-entry)) - cache) - (error - (user-error - "Couldn't parse the bib(la)tex entry with key '%s', the error was: %s" - (car key-w-entry) err))))) - t (list file))) - (ext - (user-error "Unknown bibliography extension: %S" ext)))) - (maphash - (lambda (key entry) - (condition-case err - (puthash key (citeproc-blt-entry-to-csl entry nil no-sentcase-wo-langid) - cache) - (error - (user-error - "Couldn't parse the bib(la)tex entry with key '%s', the error was: %s" - key err)))) - bt-entries) - (lambda (x) - (pcase x - ('itemids - (hash-table-keys cache)) - ((pred listp) (mapcar (lambda (id) - (cons id (gethash id cache))) - x)) - (_ (error "Unsupported citeproc itemgetter retrieval method")))))) - -(provide 'citeproc-itemgetters) - -;;; citeproc-itemgetters.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-lib.el b/elpa/citeproc-20230228.1414/citeproc-lib.el deleted file mode 100644 index 1d626c21..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-lib.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; citeproc-lib.el --- misc functions and variables for citeproc-el -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; General utility functions used in citeproc-el. - -;;; Code: - -(require 'dash) -(require 's) - -(defconst citeproc--number-vars - '(chapter-number citation-number collection-number edition first-reference-note-number - issue number number-of-pages number-of-volumes page page-first - part-number printing-number section supplement-number version volume) - "CSL number variables." - ;; Note: `locator', which is also on the official list, is omitted because - ;; it's treated specially in the code. - ) - -(defconst citeproc--date-vars - '(accessed available-date event-date issued original-date submitted) - "CSL date variables.") - -(defconst citeproc--name-vars - '(author chair collection-editor compiler composer container-author contributor - curator director editor editorial-director editor-translator executive-producer - guest host illustrator interviewer narrator organizer original-author - performer producer recipient reviewed-author script-writer series-creator - translator) - "CSL name variables.") - -(defconst citeproc--linked-vars - '(DOI PMCID PMID URL) - "Variables whose rendered content should be linked. -The ordering is according to priority ") - -(defconst citeproc--link-prefix-alist - '((DOI . "https://doi.org/") - (PMID . "https://www.ncbi.nlm.nih.gov/pubmed/") - (PMCID . "https://www.ncbi.nlm.nih.gov/pmc/articles/")) - "Alist mapping variable names to uri prefixes.") - -(defun citeproc-lib-parse-xml-file (file) - "Return the parsed xml representation of FILE." - (with-temp-buffer - (insert-file-contents file) - (libxml-parse-xml-region (point-min) (point-max)))) - -(defun citeproc-lib-remove-xml-comments (tree) - "Remove comments from xml TREE." - (let ((head (car tree)) - (attrs (cadr tree)) - (body (cddr tree)) - result) - (while body - (pcase (car body) - ((pred atom) (push (pop body) result)) - (`(comment . ,_) (pop body)) - (_ (push (citeproc-lib-remove-xml-comments (pop body)) result)))) - (let ((full-result (cons head (cons attrs (nreverse result))))) - ;; Handle the problem of the top element added by the libxml parser when - ;; there is a comment after the xml declaration. - (if (eq (car full-result) 'top) - (caddr full-result) - full-result)))) - -(defun citeproc-lib-parse-html-frag (s) - "Return the parsed representation of html in string S." - (with-temp-buffer - (insert s) - (libxml-parse-html-region (point-min) (point-max)))) - -(defun citeproc-lib-intern (s) - "Intern S if it is a string, return nil if it is nil." - (cond ((not s) nil) - ((stringp s) (intern s)) - (t (error "Function citeproc-lib-intern was called with an argument that is neither string nor nil")))) - -(defun citeproc-lib-named-parts-to-alist (e) - "Collect the attrs of parsed xml element E's enclosed elements. -The attributes are collected into an alist consisting -of (PARTNAME . ATTRS) pairs, where PARTNAME is the value of the -enclosed element's `name' attr" - (--map (cons (intern (alist-get 'name it)) - (assq-delete-all 'name it)) - (mapcar #'cadr (-remove #'stringp (cddr e))))) - -(defun citeproc-lib-lex-compare (l1 l2 cmp-fun sort-orders) - "Whether list L1 lexicographically precedes list L2. -CMP-FUN is a three-valued (1, 0, -1) comparator function, -SORT-ORDERS is a list of sort orders (see the bib- and -cite-sort-orders slots of `citeproc-style' for details). Return t -iff L1 is strictly ordered before L2, nil otherwise." - (unless sort-orders - (setq sort-orders (make-list (length l1) t))) - (let (result) - (while (and l1 (not result)) - (let ((comp - (funcall cmp-fun (pop l1) (pop l2) (not (pop sort-orders))))) - (unless (= comp 0) - (setq result comp)))) - (equal result 1))) - -(defun citeproc-lib-splice-into (list tag) - "Splice elements with car TAG into LIST." - (let (result) - (dolist (elt list) - (if (and (consp elt) (eq tag (car elt))) - (dolist (e (cdr elt)) - (push e result)) - (push elt result))) - (nreverse result))) - -(defun citeproc-lib-add-splice-tag (list tag) - "Add TAG as car if LIST is not a singleton. -Return the first element if LIST is singleton." - (if (cdr list) (cons tag list) (car list))) - -(defun citeproc-lib-numeric-p (val) - "Return whether VAL is numeric content. -VAL has numeric content if it is a number or a string containing -numeric content." - (or (numberp val) - (and (stringp val) - (s-matches-p "\\`[[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\(\\( *\\([,&-]\\|--\\) *\\)?[[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)?\\'" - val)))) - -(defun citeproc-lib-maybe-stop-rendering - (trigger context result &optional var) - "Stop rendering if a (`stop-rendering-at'. TRIGGER) pair is present in CONTEXT. -In case of stopping return with RESULT. If the optional VAR -symbol is non-nil then rendering is stopped only if VAR is eq to -TRIGGER." - (if (and (eq trigger (alist-get 'stop-rendering-at (citeproc-context-vars context))) - (or (not var) (eq var trigger)) - (eq (cdr result) 'present-var)) - (let ((rt-result (car result))) - (push '(stopped-rendering . t) (car rt-result)) - (throw 'stop-rendering (citeproc-rt-render-affixes rt-result))) - result)) - -(provide 'citeproc-lib) - -;;; citeproc-lib.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-locale.el b/elpa/citeproc-20230228.1414/citeproc-locale.el deleted file mode 100644 index aee16912..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-locale.el +++ /dev/null @@ -1,93 +0,0 @@ -;; citeproc-locale.el --- CSL locale related functions -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2022 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; In addition to some locale handling helpers, this file provides the function -;; `citeproc-locale-getter-from-dir', which constructs locale getter functions -;; that retrieve locales from a given directory. - -;;; Code: - -(require 'dash) -(require 'f) -(require 's) - -(require 'citeproc-lib) -(require 'citeproc-term) - -(defconst citeproc-locale--default-variants-alist - '(("af" . "ZA") ("ca" . "AD") ("cs" . "CZ") ("cy" . "GB") - ("da" . "DK") ("en" . "US") ("el" . "GR") ("et" . "EE") - ("fa" . "IR") ("he" . "IR") ("ja" . "JP") ("km" . "KH") - ("ko" . "KR") ("nb" . "NO") ("nn" . "NO") ("sl" . "SI") - ("sr" . "RS") ("sv" . "SE") ("uk" . "UA") ("vi" . "VN") - ("zh" . "CN")) - "Alist mapping locales to their default variants. -Only those locales are given for which the default variant is not -simply the result of upcasing.") - -(defconst citeproc-locale--simple-locales - '("la" "eu" "ar") - "List of simple locale names (without dash).") - -(defun citeproc-locale--extend (loc) - "Extend simple locale LOC to default variant." - (let ((variant (assoc-default loc citeproc-locale--default-variants-alist))) - (concat loc "-" (or variant (s-upcase loc))))) - -(defun citeproc-locale--compatible-p (l1 l2) - "Whether locales L1 and L2 are compatible." - (or (not (and l1 l2)) - (s-prefix-p l1 l2) - (s-prefix-p l2 l1))) - -(defun citeproc-locale-getter-from-dir (dir) - "Return a locale getter getting parsed locales from a local DIR. -If the requested locale couldn't be read then return the parsed -en-US locale, which must exist." - (let ((default-loc-file (f-join dir "locales-en-US.xml"))) - (lambda (loc) - (let* ((ext-loc (if (or (member loc citeproc-locale--simple-locales) - (s-contains-p "-" loc)) - loc - (citeproc-locale--extend loc))) - (loc-file (concat dir "/locales-" ext-loc ".xml")) - (loc-available (f-readable-p loc-file))) - (citeproc-lib-remove-xml-comments - (citeproc-lib-parse-xml-file - (if loc-available loc-file - (if (not (f-readable-p default-loc-file)) - (error - "The default CSL locale file %s doesn't exist or is unreadable" - default-loc-file) - default-loc-file)))))))) - -(defun citeproc-locale-termlist-from-xml-frag (frag) - "Transform xml FRAG representing citeproc--terms into a citeproc-term list." - (--mapcat (if (eq 'term (car it)) - (citeproc-term--from-xml-frag (cdr it)) - nil) - frag)) - -(provide 'citeproc-locale) - -;;; citeproc-locale.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-macro.el b/elpa/citeproc-20230228.1414/citeproc-macro.el deleted file mode 100644 index d4b6ddcd..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-macro.el +++ /dev/null @@ -1,58 +0,0 @@ -;; citeproc-macro.el --- functions to render CSL macros -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to render the output of CSL macros. - -;;; Code: - -(require 'citeproc-lib) -(require 'citeproc-rt) -(require 'citeproc-context) - -;;; For macro evaluation -(defun citeproc--macro (attrs context &rest body) - "Render the content of a macro element with ATTRS and BODY." - (let* ((spliced-body (citeproc-lib-splice-into body 'splice)) - (val (citeproc-rt-typed-join attrs spliced-body context))) - (if (eq 'empty-vars (cdr val)) - (cons nil 'text-only) - val))) - -(defun citeproc-macro-output (macro context) - "Return the output of MACRO. -MACRO is the macro's name as a string and the returned value is a -(RICH-TEXT-CONTENT . CONTENT-TYPE) cons cell." - (let ((macro-fun (assoc-default macro (citeproc-context-macros context)))) - (if macro-fun - (funcall macro-fun context) - (error "There is no macro called `%s' in style" macro)))) - -(defun citeproc-macro-output-as-text (macro context) - "Return the output of MACRO as plain text. -MACRO is the macro's name as a string." - (citeproc-rt-to-plain (citeproc-rt-render-affixes - (car (citeproc-macro-output macro context))))) - -(provide 'citeproc-macro) - -;;; citeproc-macro.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-name.el b/elpa/citeproc-20230228.1414/citeproc-name.el deleted file mode 100644 index 6825134b..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-name.el +++ /dev/null @@ -1,452 +0,0 @@ -;;; citeproc-name.el --- CSL name and label rendering -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to render CSL name and label elements. - -;;; Code: - -(require 'subr-x) -(require 'let-alist) -(require 'dash) -(require 's) - -(require 'citeproc-lib) -(require 'citeproc-s) -(require 'citeproc-rt) -(require 'citeproc-context) -(require 'citeproc-term) - -(defvar citeproc-name-postprocess-functions nil - "A list of functions to postprocess rendered names. -Each function takes three arguments: -- the rich-text rendering of a name to be post-processed, -- the rendered name as an alist with CSL name-part - keys (`family', `given' etc.), and -- the rendering context, as a `citeproc-context' structure. -The output of each function should be the post-processed -rich-text, and the functions are applied in the order they appear -in the list.") - -;; OPTIMIZE: Name count could be sped up by only counting the names to be -;; rendered without actually rendering them -(defun citeproc-name-render-vars - (varstring attrs name-attrs name-part-attrs et-al-attrs with-label - label-before-names label-attrs context) - "Render namevars contained in VARSTRING according to the given attrs. -VARSTRING is a string containing variable names separated by -spaces. Labels are also rendered (with formatting according to -LABEL-ATTRS) if WITH-LABEL is t." - (let* ((vars (-map 'intern (s-split " " varstring))) - (present-vars (--filter (citeproc-var-value it context) vars)) - ed-trans) - (when (and (memq 'editor present-vars) - (memq 'translator present-vars) - (= 2 (length present-vars)) - (equal (--map (alist-get 'name-id it) - (citeproc-var-value 'editor context)) - (--map (alist-get 'name-id it) - (citeproc-var-value 'translator context)))) - (setq present-vars '(editor) - ed-trans t)) - (unless (alist-get 'delimiter attrs) - (-when-let (names-delim (alist-get 'names-delimiter (citeproc-context-opts context))) - (push (cons 'delimiter names-delim) attrs))) - (if present-vars - (cons (citeproc-rt-join-formatted - attrs - (--map (citeproc-name--render-var it name-attrs name-part-attrs - et-al-attrs with-label - label-before-names - label-attrs - context - ed-trans) - present-vars) - context) - 'present-var) - (cons nil 'empty-vars)))) - -(defun citeproc-name--render-var (var attrs name-part-attrs et-al-attrs with-label - label-before-names - label-attrs context &optional ed-trans) - "Render the value of csl name variable VAR according to given attrs. -VAR is a symbol. - -Note: The label (if there is one) is prepended to the name(s) if -the form is verb and also when the label element was before the -names element in the style. The latter is not allowed in the -standard, so can be considered an extension. It's supported -because some styles rely on it, notably that of the journal -Nature." - ;; Push the current add-names offset for VAR to the ATTRS - (-when-let (add-names-alist (citeproc-var-value 'add-names context)) - (-when-let (add-names-val (alist-get var add-names-alist)) - (push `(add-names . ,add-names-val) attrs))) - (let* ((var-value (citeproc-var-value var context)) - (rendered-names (citeproc-name--render-names - var-value attrs et-al-attrs name-part-attrs - context))) - (when (atom rendered-names) (setq rendered-names (list nil rendered-names))) - (push (list 'rendered-names) (car rendered-names)) - (push `(variable . ,(if ed-trans "editortranslator" (symbol-name var))) - label-attrs) - (let ((plural-val (alist-get 'plural label-attrs))) - (when (or (not plural-val) (string= plural-val "contextual")) - (push `(plural . ,(if (> (length var-value) 1) "always" "never")) - label-attrs))) - (if with-label - (let ((rendered-label (car (citeproc--label label-attrs context)))) - (citeproc-rt-join-formatted `((rendered-var . ,var)) - (if label-before-names - (list rendered-label rendered-names) - (list rendered-names rendered-label)) - context)) - (push (cons 'rendered-var var) (car rendered-names)) - rendered-names))) - -(defun citeproc-name--render-names (names attrs et-al-attrs name-part-attrs context) - "Render NAMES according to the given attrs." - (let* ((all-attrs (-concat attrs (citeproc-context-opts context))) - (rmode (citeproc-context-render-mode context)) - (sort-o (if (eq rmode 'sort) "all" ;; special setting for sort mode - (alist-get 'name-as-sort-order all-attrs))) - (names-count (length names)) - (formatted-first (citeproc-name--render (car names) attrs name-part-attrs - sort-o context))) - (if (= 1 names-count) formatted-first - (let-alist all-attrs - (let ((delimiter (or .delimiter .name-delimiter ", ")) - (add-names (or .add-names 0)) - (position (citeproc-var-value 'position context))) - (unless (or (null position) (eq position 'first)) - (setq .et-al-min (or .et-al-subsequent-min .et-al-min) - .et-al-use-first (or .et-al-subsequent-use-first .et-al-use-first))) - (setq .et-al-min (or .names-min .et-al-min) - .et-al-use-first (or .names-use-first .et-al-use-first) - .et-al-use-last (or (string= .names-use-last "true") - (string= .et-al-use-last "true"))) - (let* ((et-al-min-val - ;; If et-al should be ignored then we set this to an unreachable number. - (if (alist-get 'ignore-et-al (citeproc-context-vars context)) - 100 - (citeproc-s-nil-or-s-to-num .et-al-min))) - (et-al-use-first-val (+ add-names - (citeproc-s-nil-or-s-to-num .et-al-use-first))) - (et-al (and .et-al-min .et-al-use-first - (>= names-count et-al-min-val) - (< et-al-use-first-val names-count))) - (middle-end-pos (if et-al et-al-use-first-val (- names-count 1))) - (sort-o-latters (string= sort-o "all")) - (formatted-middle - (if (< middle-end-pos 2) - nil - (citeproc-rt-join-formatted - `((delimiter . ,delimiter) (prefix . ,delimiter)) - (--map (citeproc-name--render it attrs name-part-attrs - sort-o-latters context) - (-slice names 1 middle-end-pos)) - context))) - (last-after-inverted (or sort-o-latters - (and (string= sort-o "first") - (null formatted-middle)))) - (last-delim (citeproc-lib-intern (if et-al .delimiter-precedes-et-al - .delimiter-precedes-last))) - (last-pref (if (or (and (or (not last-delim) (eq last-delim 'contextual)) - (> middle-end-pos 1)) - (eq last-delim 'always) - (and (eq last-delim 'after-inverted-name) - last-after-inverted)) - delimiter - " ")) - (formatted-last - (cond (et-al (if .et-al-use-last - (citeproc-rt-join-formatted - nil - (list - delimiter "… " - (citeproc-name--render (-last-item names) - attrs name-part-attrs - sort-o-latters context)) - context) - (citeproc-name--render-et-al (cons `(prefix . ,last-pref) - et-al-attrs) - context))) - (.and - (let ((and-str (if (string= .and "text") - (citeproc-term-get-text "and" context) - "&"))) - (citeproc-rt-join-formatted - `((prefix . ,last-pref)) - (list and-str " " - (citeproc-name--render - (-last-item names) attrs - name-part-attrs sort-o-latters context)) - context))) - (t - (citeproc-rt-join-formatted - nil - (list delimiter - (citeproc-name--render (-last-item names) - attrs name-part-attrs - sort-o-latters context)) - context))))) - (citeproc-rt-join-formatted - (--remove (eq 'delimiter (car it)) attrs) - (list formatted-first formatted-middle formatted-last) - context))))))) - -(defun citeproc-name--render (name attrs name-part-attrs sort-o context) - "Render NAME according to the given attributes." - (let* ((format-attrs - (--filter (memq (car it) (-concat '(prefix suffix) citeproc-rt-format-attrs)) - attrs)) - (result (citeproc-rt-format-single - (cons `(name-id . ,(alist-get 'name-id name)) format-attrs) - (citeproc-name--render-formatted - (citeproc-name--format-nameparts name name-part-attrs context) - attrs sort-o context) - context))) - (dolist (fn citeproc-name-postprocess-functions) - (setq result (funcall fn result name context))) - result)) - -(defun citeproc-name--parts-w-sep (c1 c2 sep context) - "Join name-parts in lists C1 C2 with spaces and then with SEP." - (let ((joined-c1 (citeproc-rt-join-formatted '((delimiter . " ")) c1 context))) - (if (-none-p 'cadr c2) - joined-c1 - (citeproc-rt-join-formatted - `((delimiter . ,sep)) - (list joined-c1 - (citeproc-rt-join-formatted '((delimiter . " ")) c2 context)) - context)))) - -(defun citeproc-name--render-formatted (name-alist attrs sort-o context) - "Render formatted name described by NAME-ALIST according to ATTRS. -NAME-ALIST is an alist with symbol keys corresponding to -name-parts like `family' etc. and values are simple rich-text -contents of the form (ATTRS CONTENT) where content must be a -single string. SORT-O is a boolean determining whether to use -sort order." - (-let* ((global-opts (citeproc-context-opts context)) - ((&alist 'family f - 'given g-uninited - 'suffix s - 'dropping-particle d - 'non-dropping-particle n - 'name-id nid) - name-alist) - ((&alist 'sort-separator sort-sep - 'initialize init - 'initialize-with init-with - 'form form - 'name-form name-form) - (-concat attrs global-opts)) - (sort-sep (or sort-sep ", ")) - (init (not (string= init "false"))) - (d-n-d (intern (alist-get 'demote-non-dropping-particle global-opts))) - (id (cadr nid)) - (show-given (citeproc-name-show-givenname-level id context)) - (form (if show-given 'long - (intern (or form name-form "long")))) - (rmode (citeproc-context-render-mode context))) - (if (citeproc-name--lat-cyr-greek-p name-alist) - (let ((g - (cond ((or (null g-uninited) - (and show-given (= show-given 2))) - g-uninited) - ((and init-with init) - (list (citeproc-rt-attrs g-uninited) - (citeproc-name--initialize - (citeproc-rt-first-content g-uninited) - init-with - (string= "false" - (alist-get 'initialize-with-hyphen - global-opts))))) - (init-with - (list (citeproc-rt-attrs g-uninited) - (citeproc-name--initials-add-suffix - init-with - (citeproc-rt-first-content g-uninited)))) - (t g-uninited)))) - (if (eq form 'long) - (if sort-o - (if (or (eq d-n-d 'never) - (and (eq d-n-d 'sort-only) (eq rmode 'display))) - (citeproc-name--parts-w-sep - (citeproc-name--conc-nps n f) (list g d s) sort-sep - context) - (citeproc-name--parts-w-sep (list f) (list g d n s) sort-sep context)) - (citeproc-rt-join-formatted - '((delimiter . " ")) `(,g ,@(citeproc-name--conc-nps - d n f) ,s) - context)) - (citeproc-rt-join-formatted - '((delimiter . " ")) (citeproc-name--conc-nps n f) context))) - (if (eq form 'long) - (citeproc-rt-join-formatted '((delimiter . " ")) (list f g-uninited) context) - f)))) - -(defun citeproc-name--conc-nps (&rest nps) - "Concatenate particles in name-parts NPS if they end with apostrophe." - (let ((nonnils (delq nil nps))) - (if (cdr nonnils) - (let* ((len (length nonnils)) - (particle (nth (- len 2) nonnils)) - (particle-str (if (listp particle) (cadr particle) particle))) - (if (string= "ʼ" (substring particle-str -1)) - (let* ((family (car (last nonnils))) - (result (list (list nil particle family)))) - (when (> 2 len) (push (car nonnils) result)) - result) - nonnils)) - nonnils))) - -(defun citeproc-name--lat-cyr-greek-p (name-alist) - "Return t if NAME-ALIST is cyrillic/latin/greek and nil otherwise. -NAME-ALIST is like in `citeproc-name--render-formatted'" - (--all-p (or (not (stringp it)) (string-match "^\\(\\cl\\|\\cy\\|\\cg\\|ʼ\\)*$" - it)) - (-map (lambda (x) - (if (listp (cdr x)) (cl-caddr x) - (cdr x))) - name-alist))) - -(defun citeproc-name--initialize (names suffix &optional remove-hyphens) - "Initialize NAMES and add SUFFIX. -NAMES is a string containing one or more space-separated names, -while SUFFIX is either nil or a string (e.g. \".\"). If the -optional REMOVE-HYPHENS is non-nil then don't keep hyphens -between initalized given names, e.g., initialize Jean-Paul to -J.P. instead of the default J.-P." - (let ((trimmed-suffix (s-trim suffix))) - (concat (s-join - suffix - (--map - (if (s-match "-" it) - (citeproc-name--initialize-hyphenated it suffix remove-hyphens) - (s-left 1 it)) - (s-split " +" names))) - trimmed-suffix))) - -(defun citeproc-name--initialize-hyphenated (name suffix &optional remove-hyphens) - "Initialize space-less but hyphenated NAME with SUFFIX. -If the optional REMOVE-HYPHENS is non-nil then don't keep hyphens -between the initalized given names, e.g., initialize Jean-Paul to -J.P. instead of the default J.-P." - (let ((inner-suffix (s-trim suffix))) - (s-join (if remove-hyphens inner-suffix - (concat inner-suffix "-")) - (--map (s-left 1 it) - (s-split "-" name))))) - -(defun citeproc-name--initials-add-suffix (suffix names) - "Add SUFFIX to initials in NAMES. -NAMES is a string containing one or more space-separated names, -while SUFFIX is a string (e.g. \".\")." - (let ((suffix (s-trim suffix))) - (mapconcat (lambda (x) - (if (and (cdr x) (s-match "^[[:alpha:]]$" (car x))) - (concat (car x) suffix) - (car x))) - (citeproc-s-slice-by-matches names "[ \\-]" 0 t) - ""))) - -(defun citeproc-name--format-nameparts (name-alist name-part-attrs context) - "Format nameparts in NAME-ALIST according to NAME-PART-ATTRS. -Return a new name alist containg the same keys with formatted -contents." - (-let (((&alist 'given given-attrs - 'family family-attrs) - name-part-attrs)) - (--map (-let (((n-part . content) it)) - (cons n-part - (cond ((and given-attrs - (memq n-part '(given dropping-particle))) - (citeproc-rt-format-single given-attrs content context)) - ((and family-attrs - (memq n-part '(family non-dropping-particle))) - (citeproc-rt-format-single family-attrs content context)) - (t (list nil content))))) - name-alist))) - -(defun citeproc-name--render-et-al (attrs context) - "Render the `et al' part of a name acc. to ATTRS." - (let ((rmode (citeproc-context-render-mode context))) - (if (eq rmode 'sort) "" - (let ((term (or (alist-get 'term attrs) - "et-al"))) - (citeproc-rt-format-single attrs - (citeproc-term-get-text term context) - context))))) - -(defun citeproc-name-show-givenname-level (id context) - "Return the disambiguation level of name with ID." - (alist-get id (alist-get 'show-given-names (citeproc-context-vars context)))) - -(defun citeproc--var-plural-p (var context) - "Return whether the content of variable VAR is plural. -VAR is a symbol." - (let ((content (citeproc-rt-to-plain (citeproc-var-value var context)))) - (if (or (string= var "number-of-pages") - (string= var "number-of-volumes")) - (> (string-to-number content) 1) - (string-match-p - (concat "[[:digit:]] *\\([-,;–&—―]+\\|[,;]? *" - (citeproc-term-get-text "and" context) - "\\) *[a-zA-Z]?[[:digit:]]") - content)))) - -(defun citeproc--label (attrs context &rest _body) - "Render a CSL label element with the given ATTRS in CONTEXT." - (-let* (((&alist 'variable variable - 'form form - 'plural plural) - attrs) - (label (intern variable)) - (number nil)) - (if (or (eq label 'editortranslator) - (and label (citeproc-var-value label context))) - (progn - (if form (setq form (intern form)) - (setq form 'long)) - (when (string= variable "locator") - (setq variable (citeproc-locator-label context))) - (cond ((string= plural "never") (setq number 'single)) - ((string= plural "always") (setq number 'multiple)) - (t (setq number - (if (citeproc--var-plural-p label context) - 'multiple - 'single)))) - ;; Add rendered locator label info in cite mode. - (when (and (eq label 'locator) - (eq (citeproc-context-mode context) 'cite)) - (push '(rendered-locator-label . t) attrs)) - (cons (citeproc-rt-format-single attrs (citeproc-term-inflected-text - variable form number context) - context) - 'text-only)) - (cons nil 'text-only)))) - -(provide 'citeproc-name) - -;;; citeproc-name.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-number.el b/elpa/citeproc-20230228.1414/citeproc-number.el deleted file mode 100644 index bf9897bf..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-number.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; citeproc-number.el --- render CSL number elements -*- lexical-binding: t; -*- - -;; Copyright "(C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to render CSL number elements. - -;;; Code: - -(require 'subr-x) -(require 'rst) -(require 's) - -(require 'citeproc-context) -(require 'citeproc-lib) -(require 'citeproc-s) -(require 'citeproc-rt) - -(defun citeproc-number-extract (val) - "Return the parse of string VAL holding numeric content." - (cdr (s-match - "\\`\\([[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)\\(?:\\(?: *\\([,&-–—―]\\|--\\) *\\)\\([[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)\\)?\\'" - val))) - -(defun citeproc--number (attrs context &rest _body) - "Render a cs:number element with the given ATTRS in CONTEXT." - (-let* (((&alist 'variable var - 'form form) - attrs) - (variable (intern var)) - (value (citeproc-var-value variable context)) - (form (citeproc-lib-intern form))) - (if (not value) - (cons nil 'empty-var) - (let ((result-attrs - (cons `(rendered-var . ,variable) attrs)) - (result-cont - (citeproc-number-var-value value variable form context))) - (cons (citeproc-rt-format-single result-attrs result-cont context) - 'present-var))))) - -(defconst citeproc--format-numsep-alist - '(("&" . " & ") - ("," . ", ") - ("-" . "-") - ("--" . "-") - ("—" . "-") - ("―" . "-")) - "Alist specifying the proper formatting of number-pair separators.") - -(defun citeproc-number-var-value (value variable form context) - "Return the numeric VALUE of VARIABLE formatted in FORM. -VARIABLE is a symbol." - (cond ((not value) nil) - ((numberp value) (number-to-string value)) - (t (--if-let (citeproc-number-extract value) - (let ((formatted-first - (citeproc-number--format (car it) form variable context))) - (if (> (length it) 1) - (concat - formatted-first - (assoc-default (cadr it) citeproc--format-numsep-alist) - (citeproc-number--format (cl-caddr it) form variable context)) - formatted-first)) - value)))) - -(defun citeproc-number--format (s form term context) - "Render the number in string S for TERM in format FORM." - (if (s-matches-p "[[:alpha:]]" s) s - (pcase form - ('roman (downcase (rst-arabic-to-roman (string-to-number s)))) - ('ordinal (citeproc-number--format-as-ordinal s term context)) - ('long-ordinal (citeproc-number--format-as-long-ordinal s term context)) - (_ s)))) - -(defun citeproc-number--format-as-ordinal (s term context) - "Format numeric string S as ordinal agreeing with TERM." - (let* ((terms (citeproc-context-terms context)) - (padded (if (= 1 (length s)) - (concat "0" s) - s)) - (gender (citeproc-term-get-gender term context)) - (matches - (--filter (and (string= (s-left 8 (citeproc-term-name it)) "ordinal-") - (citeproc-number--ordinal-matches-p padded gender it)) - terms)) - (suffix - (citeproc-term-text - (if (not matches) - (-when-let (ordinal-matches - (--filter (string= (citeproc-term-name it) "ordinal") - terms)) - (-if-let (match (--first (eq (citeproc-term-gender-form it) gender) - ordinal-matches)) - match - (car ordinal-matches))) - (let ((first-term (car matches))) - (-if-let (second-term (cadr matches)) - (if (= (elt (citeproc-term-name first-term) 8) ?0) - second-term - first-term) - first-term)))))) - (concat s suffix))) - -(defconst citeproc-number--ordinal-match-alist - '((last-two-digits . 2) - (last-digit . 1) - (whole-number . nil)) - "Alist mapping ordinal match attributes to the required match lengths.") - -(defun citeproc-number--ordinal-matches-p (s gender ord-term) - "Whether S term with GENDER matches ordinal-term ORD-TERM." - (and (eq gender (citeproc-term-gender-form ord-term)) - (let ((match (citeproc-term-match ord-term)) - (term-num (s-right 2 (citeproc-term-name ord-term)))) - (unless match - (setq match - (if (= (elt (citeproc-term-name ord-term) 8) ?0) - 'last-digit - 'last-two-digits))) - (let ((l (assoc-default match citeproc-number--ordinal-match-alist))) - (string= (citeproc-s-tail s l) - (citeproc-s-tail term-num l)))))) - -(defun citeproc-number--format-as-long-ordinal (s term context) - "Format numeric string S as a long ordinal agreeing with TERM." - (let ((num-val (string-to-number s))) - (if (> num-val 10) - (citeproc-number--format-as-ordinal s term context) - (when (= 1 (length s)) (setq s (concat "0" s))) - (let* ((name (concat "long-ordinal-" s)) - (gender (citeproc-term-get-gender term context)) - (match (--first (and (string= (citeproc-term-name it) name) - (eq (citeproc-term-gender-form it) gender)) - (citeproc-context-terms context)))) - (if match - (citeproc-term-text match) - (citeproc-term-get-text name context)))))) - -(provide 'citeproc-number) - -;;; citeproc-number ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-pkg.el b/elpa/citeproc-20230228.1414/citeproc-pkg.el deleted file mode 100644 index 980f8dd5..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-pkg.el +++ /dev/null @@ -1,21 +0,0 @@ -(define-package "citeproc" "20230228.1414" "A CSL 1.0.2 Citation Processor" - '((emacs "26") - (dash "2.13.0") - (s "1.12.0") - (f "0.18.0") - (queue "0.2") - (string-inflection "1.0") - (org "9") - (parsebib "2.4")) - :commit "290320fc579f886255f00d7268600df7fa5cc7e8" :authors - '(("András Simonyi" . "andras.simonyi@gmail.com")) - :maintainers - '(("András Simonyi" . "andras.simonyi@gmail.com")) - :maintainer - '("András Simonyi" . "andras.simonyi@gmail.com") - :keywords - '("bib") - :url "https://github.com/andras-simonyi/citeproc-el") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/citeproc-20230228.1414/citeproc-prange.el b/elpa/citeproc-20230228.1414/citeproc-prange.el deleted file mode 100644 index 52a5fb39..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-prange.el +++ /dev/null @@ -1,128 +0,0 @@ -;;; citeproc-prange.el --- page-range rendering -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to render CSL page-ranges. - -;;; Code: - -(defun citeproc-prange--end-significant (start end len) - "Return the significant digits of the end in page range START END. -START and END are strings of equal length containing integers. If -the significant part of END is shorter than LEN then add -insignificant digits from END until the string is LEN long or -there are no more digits left." - (let ((first (min (max 1 (1+ (- (length end) len))) - (abs (compare-strings start nil nil end nil nil))))) - (substring end (1- first)))) - -(defun citeproc-prange--end-complete (start end len) - "Complete the closing form of a START END pagerange to LEN." - (citeproc-prange--end-significant start (citeproc-s-fill-copy end start) len)) - -(defun citeproc-prange--end-expanded (_start end end-pref) - "Render the end of range _START END in `expanded' format. -END-PREF is an optional non-numeric prefix preceding END. All -arguments are strings, END has the same length as START." - (concat end-pref end)) - -(defun citeproc-prange--end-minimal (start end _end-pref) - "Render the end of range START END in `minimal' format. -END-PREFIX is an optional non-numeric prefix preceding END. All -arguments are strings, END has the same length as START." - (citeproc-prange--end-significant start end 1)) - -(defun citeproc-prange--end-minimal-two (start end _end-pref) - "Render the end of range START END in `minimal-two' format. -END-PREFIX is an optional non-numeric prefix preceding END. All -arguments are strings, END has the same length as START." - (citeproc-prange--end-significant start end 2)) - -(defun citeproc-prange--end-chicago (start end _end-pref &optional 15th-ed) - "Render the end of range START END in `chicago' format. -END-PREFIX is an optional non-numeric prefix preceding END. All -arguments are strings, END has the same length as START. If -optional 15TH-ED is non-nil then use the special 4digit rule of -the 15th edition." - (let ((len (length start))) - (cond ((or (< len 3) (string= (substring start -2) "00")) - end) - ((string= (substring start -2 -1) "0") - (citeproc-prange--end-significant start end 1)) - ((and 15th-ed (= 4 (length start))) - (let ((min-two (citeproc-prange--end-significant start end 2))) - (if (> (length min-two) 2) end min-two))) - (t (citeproc-prange--end-significant start end 2))))) - -(defconst citeproc-prange-formatters-alist - `((chicago . ,(lambda (start end end-pref) - (citeproc-prange--end-chicago start end end-pref t))) - (chicago-15 . ,(lambda (start end end-pref) - (citeproc-prange--end-chicago start end end-pref t))) - (chicago-16 . citeproc-prange--end-chicago) - (minimal . citeproc-prange--end-minimal) - (minimal-two . citeproc-prange--end-minimal-two) - (expanded . citeproc-prange--end-expanded)) - "Alist mapping page range formats to formatter functions.") - -(defun citeproc-prange-render (p format sep) - "Render page range P in FORMAT with separator SEP." - (with-temp-buffer - (insert p) - (goto-char 0) - (while (search-forward-regexp - "\\([[:digit:]]*[[:alpha:]]\\)?\\([[:digit:]]+\\)\\( ?\\)\\([-–—]+\\)\\( ?\\)\\([[:digit:]]*[[:alpha:]]\\)?\\([[:digit:]]+\\)" - nil t) - (let* ((start-pref (match-string 1)) - (start-num (match-string 2)) - (orig-dash (match-string 4)) - (orig-sep (concat (match-string 3) orig-dash (match-string 5))) - (end-pref (match-string 6)) - (end-num (match-string 7)) - (end (concat end-pref end-num)) - (old-sep-w-end (concat orig-sep end)) - ;; Note: To conform with the official CSL tests we don't replace the separating - ;; dash with SEP if collapse cannot be applied because of incompatible prefixes - ;; but we still remove spaces surrounding the dash. It would make far more - ;; sense to replace the dash as well. - (new-sep-w-end (cond ((not (string= start-pref end-pref)) - (concat orig-dash end)) - ;; Deal with degenerate single page "ranges" - ((string= start-num end-num) - "") - ((or (not format) (> (length end-num) (length start-num))) - (concat sep end)) - (t (concat - sep - (funcall (alist-get format - citeproc-prange-formatters-alist) - start-num - (citeproc-s-fill-copy end-num start-num) - end-pref)))))) - (unless (string-equal new-sep-w-end old-sep-w-end) - (delete-char (- (length old-sep-w-end))) - (insert new-sep-w-end)))) - (buffer-string))) - -(provide 'citeproc-prange) - -;;; citeproc-prange.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-proc.el b/elpa/citeproc-20230228.1414/citeproc-proc.el deleted file mode 100644 index 9fd635b8..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-proc.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; citeproc-proc.el --- construct and manage citation processors -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; 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 &optional uncited) - "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 :uncited uncited))) - (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 t)))))) - -(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-json-name (rep) - "Parse the json representation REP of a csl name variable." - (if-let ((literal (alist-get 'literal rep))) - (list (cons 'family (citeproc-s-smart-apostrophes literal))) - (let ((filtered (-remove (lambda (x) (eq (car x) 'isInstitution)) rep))) - (--map (cons - (car it) - (let ((text-field (cdr it))) - (if (stringp text-field) - (citeproc-s-smart-apostrophes text-field) - text-field))) - filtered)))) - -(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 (citeproc-proc--internalize-name - (citeproc-proc--parse-csl-json-name it) - 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))))) - -(defun citeproc-proc-filtered-bib-p (proc) - "Return whether PROC has nontrivial filters" - (let ((filters (citeproc-proc-bib-filters proc))) - (and filters (not (equal filters '(nil)))))) - -(provide 'citeproc-proc) - -;;; citeproc-proc.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-rt.el b/elpa/citeproc-20230228.1414/citeproc-rt.el deleted file mode 100644 index 9e36268a..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-rt.el +++ /dev/null @@ -1,650 +0,0 @@ -;; citeproc-rt.el --- citeproc-el rich-text functions -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions operating on rich-text contents. In citeproc-el, rich-texts are -;; represented either by strings or by lists of the form (ATTRS RT_1 RT_2...) -;; where ATTRS is an alist consisting of (FORMAT-ATTR . VALUE) pairs and RT_1, -;; RT_2... are all rich-texts. The constants `citeproc-rt-format-attrs' and -;; `citeproc-rt-ext-format-attrs' define the list of normal and extended format -;; attributes, respectively. As a degenerate case, nil is also a legitimate -;; rich-text. - -;;; Code: - -(require 'subr-x) -(require 'dash) -(require 'cl-lib) -(require 'let-alist) -(require 's) - -(require 'citeproc-s) -(require 'citeproc-lib) - -(defconst citeproc-rt-format-attrs - '(font-variant font-style font-weight text-decoration vertical-align font-variant - display rendered-var name-id quotes cited-item-no bib-item-no - rendered-names href stopped-rendering rendered-locator-label) - "The rich-text content format attributes (used in raw output).") - -(defconst citeproc-rt-ext-format-attrs - (-concat '(prefix suffix delimiter subst quotes) citeproc-rt-format-attrs) - "The list of extended format attributes.") - -(defun citeproc-rt-to-plain (rt) - "Return the plain-text content of rich-text RT." - (if (listp rt) - (mapconcat 'citeproc-rt-to-plain - (cdr rt) - "") - rt)) - -(defun citeproc-rt-attrs (rt) - "Return the attrs of rich content RT." - (if (listp rt) (car rt) nil)) - -(defun citeproc-rt-first-content (rt) - "Return the first content element of rich content RT." - (if (listp rt) (cadr rt) rt)) - -(defun citeproc-rt-select-attrs (attrs keep) - "Select attr-val pairs from alist ATTRS whose attr is in KEEP." - (--filter (memq (car it) keep) - attrs)) - -(defun citeproc-rt-join-strings (rt) - "Concatenate consecutive strings in rich-text RT." - (cond ((< (length rt) 2) - rt) - ((and (char-or-string-p (car rt)) - (char-or-string-p (cadr rt))) - (citeproc-rt-join-strings (cons (concat (car rt) - (cadr rt)) - (cddr rt)))) - (t (cons (car rt) - (citeproc-rt-join-strings (cdr rt)))))) - -(defun citeproc-rt-splice-unformatted (rt) - "Splice the body of its unformatted elements into rich-text RT." - (if (and (consp rt) (not (alist-get 'delimiter (car rt)))) - (cons (car rt) - (--mapcat (if (citeproc-rt-formatting-empty-p it) - (cdr it) - (list it)) - (cdr rt))) - rt)) - -(defun citeproc-rt-formatting-empty-p (rt) - "Is the formatting of rich-text RT empty/redundant?" - (and (consp rt) (or (not (caar rt)) - (and (eq (cl-caaar rt) 'delimiter) - (= (length (car rt)) 1) - (= (length rt) 2))))) - -(defun citeproc-rt-reduce-content (rt) - "Reduce rich-text RT if it has no attributes or body. -Return the original RT if it has non-empty attrs and content." - (cond ((not (cdr rt)) nil) - ((and (not (car rt)) (= (length rt) 2)) (cadr rt)) - (t rt))) - -(defun citeproc-rt-simplify-shallow (rt) - "Simplify the first level of rich-text RT." - (citeproc-rt-reduce-content (citeproc-rt-join-strings - (citeproc-rt-splice-unformatted rt)))) - -(defun citeproc-rt-simplify-deep (rt) - "Simplify all levels of rich-text RT." - (if (not (consp rt)) rt - (-let* (((attrs . conts) rt) - (simplifieds (--map (citeproc-rt-simplify-deep it) - conts))) - (citeproc-rt-reduce-content - (citeproc-rt-join-strings - (citeproc-rt-splice-unformatted (cons attrs simplifieds))))))) - -(defun citeproc-rt-map-strings (fun rts &optional skip-nocase) - "Map through FUN all strings in rich-texts RTS. -Return a new rich-text with all S content strings replaced by the -value of FUN applied to S. No formatting is changed. If optional -SKIP-NOCASE is non-nil then skip spans with the `nocase' -attribute set to non-nil." - (--map (citeproc-rt-format it fun skip-nocase) rts)) - -(defun citeproc-rt-format (rt fun &optional skip-nocase) - "Format all plain text in RT with FUN. -If optional SKIP-NOCASE is non-nil then skip spans with the -`nocase' attribute set to non-nil." - (pcase rt - (`nil nil) - ((pred listp) (if (and skip-nocase (alist-get 'nocase (car rt))) - rt - (cons (car rt) (citeproc-rt-map-strings fun (cdr rt) skip-nocase)))) - (_ (funcall fun rt)))) - -(defun citeproc-rt-replace-all-sim (replacements regex rts) - "Make all REPLACEMENTS simultaneously in the strings of rich-texts RTS." - (citeproc-rt-map-strings (lambda (x) (citeproc-s-replace-all-sim x regex replacements)) - rts)) - -(defun citeproc-rt-strip-periods (rts) - "Remove all periods from rich-texts RTS." - (citeproc-rt-map-strings (lambda (x) (citeproc-s-replace "." "" x)) rts)) - -(defun citeproc-rt-length (rt) - "Return the length of rich-text RT as a string." - (if (listp rt) - (-sum (mapcar #'citeproc-rt-length (cdr rt))) - (length rt))) - -(defun citeproc-rt--update-from-plain-1 (rt p start &optional skip-nocase) - "Update rich-text RT from plain text P from position START in P. -The length of the plain text content of RT must not be less than -the length of P. If optional SKIP-NOCASE is non-nil then skip -spans with the `nocase' attribute set to non-nil. - Return an (UPDATED . NEXT) pair where UPDATED is the updated -rich-text and NEXT is the first position in P which was not used -for the update." - (pcase rt - (`nil nil) - ((pred listp) - (if (and skip-nocase (alist-get 'nocase (car rt))) - (cons rt (+ start (citeproc-rt-length rt))) - (let ((act-start start)) - (cons (cons (car rt) - (--map (-let (((updated . next) - (citeproc-rt--update-from-plain-1 - it p act-start skip-nocase))) - (setq act-start next) - updated) - (cdr rt))) - act-start)))) - (_ (let ((end (+ start (length rt)))) - (cons (substring p start end) end))))) - -(defun citeproc-rt-update-from-plain (rt p &optional skip-nocase) - "Update rich-text RT from plain text P. -The length of the plain text content of RT must not be less than -the length of P. Return the updated rich-text. If optional -SKIP-NOCASE is non-nil then skip spans with the `nocase' -attribute set to non-nil." - (car (citeproc-rt--update-from-plain-1 rt p 0 skip-nocase))) - -(defun citeproc-rt-change-case (rt case-fun) - "Change the case of rich text RT with CASE-FUN. -CASE-FUN is a function taking a string as its argument and -returning a string of the same length." - (let ((plain (citeproc-rt-to-plain rt))) - (citeproc-rt-update-from-plain rt (funcall case-fun plain) t))) - -(defun citeproc-rt-pred-counts-tree (rt pred) - "Return a dominated count tree for rich text RT based on PRED. -The returned tree has the same structure as RT but the car of -each subtree is a number indicating the maximal number of nodes -on any dominated branch for which PRED holds." - (if (consp rt) - (let ((children-vals (--map (citeproc-rt-pred-counts-tree it pred) - (cdr rt)))) - (cons (-max (cl-mapcar (lambda (rich count) - (+ (if (listp count) (car count) count) - (if (funcall pred rich) 1 0))) - (cdr rt) - children-vals)) - children-vals)) - 0)) - -(defun citeproc-rt-flip-italics (rt) - "Flip the italic attribute of rich text RT." - (if (listp rt) - (cons (if (citeproc-rt-in-italics-p rt) - (--remove (eq (car it) 'font-style) (car rt)) - (cons '(font-style . "italic") (car rt))) - (cdr rt)) - `(((font-style . "italic")) ,rt))) - -(defun citeproc-rt-in-italics-p (rt) - "Whether rich text RT has italic font style as attribute." - (and (listp rt) - (string= (alist-get 'font-style (car rt)) "italic"))) - -(defun citeproc-rt-italics-flipflop (rt) - "Return a flipflopped italics version of rich text RT." - (if (and rt (listp rt)) - (let ((italics-counts-tree - (citeproc-rt-pred-counts-tree rt 'citeproc-rt-in-italics-p))) - (if (> (+ (car italics-counts-tree) - (if (citeproc-rt-in-italics-p rt) 1 0)) - 1) - (citeproc-rt--italics-flipflop-1 rt italics-counts-tree) - rt)) - rt)) - -(defun citeproc-rt--italics-flipflop-1 (rt italics-counts-tree) - "Flipflop italics in RT using info from ITALICS-COUNTS-TREE." - (let ((rt-italic (citeproc-rt-in-italics-p rt))) - (if (or (not (listp rt)) - (not (listp italics-counts-tree)) - (< (+ (car italics-counts-tree) - (if rt-italic 1 0)) - 2)) rt - (if rt-italic - (cons (--remove (eq (car it) 'font-style) (car rt)) - (cl-mapcar (lambda (r i) - (citeproc-rt--italics-flipflop-1 - (citeproc-rt-flip-italics r) i)) - (cdr rt) - (cdr italics-counts-tree))) - (cons (car rt) - (cl-mapcar (lambda (r i) (citeproc-rt--italics-flipflop-1 r i)) - (cdr rt) - (cdr italics-counts-tree))))))) - -(defun citeproc-rt-from-str (s) - "Parse a html or plain text string S into rich text." - (if (and s (s-matches-p "" s)) - (let* ((parsed (citeproc-lib-parse-html-frag s)) - (body (cddr (cl-caddr parsed))) - (stripped (if (eq (caar body) 'p) (cl-cddar body) body))) - (if (= 1 (length stripped)) - (citeproc-rt-from-html (car stripped)) - (cons nil (mapcar 'citeproc-rt-from-html stripped)))) - s)) - -(defconst citeproc-rt-from-html-alist - '(((i . nil) . (font-style . "italic")) - ((b . nil) . (font-weight . "bold")) - ((span . ((style . "font-variant:small-caps;"))) . (font-variant . "small-caps")) - ((sc . nil) . (font-variant . "small-caps")) - ((sup . nil) . (vertical-align . "sup")) - ((sub . nil) . (vertical-align . "sub")) - ((span . ((class . "nocase"))) . (nocase . t)) - ((span . ((class . "underline"))) . (text-decoration . "underline"))) - "A mapping from html tags and attrs to rich text attrs.") - -(defun citeproc-rt-from-html (h) - "Convert simple html H to rich text." - (if (listp h) - (cons (-if-let (attr (assoc-default (cons (car h) (cadr h)) - citeproc-rt-from-html-alist)) - (list attr) - '(nil)) - (mapcar #'citeproc-rt-from-html (cddr h))) - h)) - -(defun citeproc-rt--cquote-pstns-1 (rt offset) - "Return closing quote positions in rich text RT with OFFSET. -The positions are in the plain text of RT and only those -positions are returned which are associated with a CSL -`quotes'=\"yes\" attribute." - (if (listp rt) - (let ((inner (let ((act-offset offset) - pstns) - (--each (cdr rt) - (-let (((p . next) - (citeproc-rt--cquote-pstns-1 it act-offset))) - (setq pstns (nconc pstns p) - act-offset next))) - (cons pstns act-offset)))) - (if (string= (alist-get 'quotes (car rt)) "true") - (-let (((inner-pstns . inner-offset) inner)) - (cons (cons (1- inner-offset) inner-pstns) - inner-offset)) - inner)) - (cons nil (+ offset (length rt))))) - -(defun citeproc-rt--cquote-pstns (rt) - "Return a list of closing quote positions in RT. -The positions are in the plain text of RT and only those -positions are returned which are associated with a CSL -`quotes'=\"yes\" attribute. Numbering starts from 1. -The positions are in decreasing order." - (sort (car (citeproc-rt--cquote-pstns-1 rt 1)) '>)) - -(defun citeproc-rt-punct-in-quote (rt) - "Put commas and periods inside quotes in rich text RT." - (-if-let (pstns (citeproc-rt--cquote-pstns rt)) - (let ((plain (citeproc-rt-to-plain rt))) - (citeproc-rt-update-from-plain - rt - (with-temp-buffer - (insert plain) - (dolist (pos pstns) - (goto-char (1+ pos)) - (when (memq (char-after) '(?, ?.)) - (call-interactively 'transpose-chars))) - (buffer-string)))) - rt)) - -(defun citeproc-rt-find-first-node (rt pred) - "Return the first node of RT for which PRED holds. -Return nil if no such node was found." - (if (funcall pred rt) rt - (pcase rt - ;; process further if internal node with content - (`(,_ . ,body) - (let (found) - (while (and (not found) body) - (setq found (citeproc-rt-find-first-node (car body) pred)) - (pop body)) - found)) - ;; leaf or node with no content - (_ nil)))) - -(defun citeproc-rt-transform-first (rt pred transform) - "Apply TRANSFORM to the first node of RT for which PRED is non-nil. -PRED and TRANSFORM are functions taking a rich-text node as their -sole argument. Return a (RESULT . SUCCESS) pair where RESULT is -the resulting rich-text and SUCCESS is non-nil iff the -transformation was successfully carried out (i.e., a node -satisfying PRED was found)." - (if (funcall pred rt) (cons (funcall transform rt) t) - (pcase rt - ;; process further if internal node with content - (`(,attrs . ,body) - (let* (success - (new-body - (--map (if success it - (-let (((it-res . it-success) - (citeproc-rt-transform-first it pred transform))) - (setq success it-success) - it-res)) - body))) - (cons (cons attrs new-body) success))) - ;; leaf or node with no content - (_ (cons rt nil))))) - -(defun citeproc-rt-add-year-suffix (rt ys) - "Attempt to add year suffix YS to rich-text RT. -Return an (RT . SUCCESS) pair, where RT is the resulting -rich-text, and SUCCESS is non-nil iff the year-suffix has been -successfully added." - (cl-flet ((rendered-date-var-p - (node) - (and (consp node) - (memq (alist-get 'rendered-var (car node)) citeproc--date-vars))) - (add-suffix - (node) - (let ((content (cadr node))) - (if (equal content "") - (list (car node) ys) - (let ((full-ys (if (or (not (stringp content)) - (s-matches-p "[[:digit:]]$" content)) - ys - (concat "-" ys)))) - (-snoc node `(((rendered-var . year-suffix)) ,full-ys))))))) - (citeproc-rt-transform-first rt #'rendered-date-var-p #'add-suffix))) - -(defun citeproc-rt-replace-first-names (rt replacement) - "Replace RT's first name-var content with REPLACEMENT. -Return an (RT . SUCCESS) pair, where RT is the resulting -rich-text, and SUCCESS is non-nil iff the replacement has been -successful." - (cl-flet ((rendered-name-var-p - (node) - (and (consp node) - (assoc 'rendered-names (car node)))) - (replace (_node) replacement)) - (citeproc-rt-transform-first rt #'rendered-name-var-p #'replace))) - -(defun citeproc-rt-count-names (rt) - "Return a count of the rendered names in RT." - (if (consp rt) - (if (alist-get 'name-id (car rt)) 1 - (apply #'+ (mapcar #'citeproc-rt-count-names (cdr rt)))) - 0)) - -(defun citeproc-rt-cull-spaces-puncts (rt) - "Remove unnecessary characters from rich-text RT." - (let* ((plain (citeproc-rt-to-plain rt)) - (updated (citeproc-rt-update-from-plain - rt (citeproc-s-cull-spaces-puncts plain)))) - (citeproc-rt-format updated - (lambda (x) (replace-regexp-in-string "+" "" x))))) - -(defun citeproc-rt-render-affixes (rt &optional shallow) - "Render the affixes in rich-text RT. -If SHALLOW is non-nil then render only the affixes for the first -level." - (if (not (consp rt)) - rt - (-let* (((attrs . contents) rt) - (rendered - (if shallow ; We do the recursive call depending on SHALLOW - contents - (-non-nil (--map (citeproc-rt-render-affixes it) contents))))) - (if rendered - (let-alist attrs - (let ((delimited (if .delimiter - (cdr (--mapcat (list .delimiter it) rendered)) - rendered))) - (if (or .suffix .prefix) - (let (result - outer-attrs - (inner-attrs - (citeproc-rt-select-attrs attrs citeproc-rt-format-attrs))) - (when .display ; The display attribute should encompass affixes - (setq outer-attrs (list (cons 'display .display)) - inner-attrs (--remove (eq (car it) 'display) inner-attrs))) - (when .suffix (push .suffix result)) - (push (cons inner-attrs - delimited) - result) - (when .prefix (push .prefix result)) - (cons outer-attrs result)) - (cons (citeproc-rt-select-attrs attrs citeproc-rt-format-attrs) - delimited)))) - nil)))) - -(defun citeproc-rt-dedup (rt) - "Remove duplicate substituted renderings from content RT." - (car (citeproc-rt--dedup-single rt nil))) - -(defun citeproc-rt--dedup-single (rt substs) - "Remove duplicate subst. var renderings from RT. -SUBSTS contains an initial list of vars to be removed. Return -a ( ) list." - (if (not (consp rt)) - (list rt nil nil) - (-let* (((attrs . cs) rt) - ((&alist 'subst subst - 'rendered-var var) - attrs)) - (if (and var (memq var substs)) - (list nil nil nil) - (-let (((new-c s v) (citeproc-rt--dedup-multi cs substs))) - (list (cons (--reject (memq (car it) '(subst rendered-vars)) attrs) - new-c) - (if subst - (-concat v (when var (list var))) - s) - (-concat v (if var - (list var) - nil)))))))) - -(defun citeproc-rt--dedup-multi (cs substs) - (if cs - (-let* (((c s1 v1) (citeproc-rt--dedup-single (car cs) substs)) - ((cs s2 v2) (citeproc-rt--dedup-multi (cdr cs) (-concat substs s1)))) - (list (cons c cs) - (-concat s1 s2) - (-concat v1 v2))) - (list nil nil nil))) - -(defun citeproc-rt-finalize (rt &optional punct-in-quote) - "Finalize rich text RT. -If the optional PUNCT-IN-QUOTE is non-nil then put punctuation -inside quotes. - -Note: Finalization doesn't include culling, because some -rich-text transformations require the state before culling (e.g. -the replacement of subsequent authors)." - ;; The first step is to replace the internally used `modifier letter - ;; apostrophe' characters with the normal `right single quotation marks' - (citeproc-rt-format (citeproc-rt-simplify-deep - (citeproc-rt-italics-flipflop - (if punct-in-quote (citeproc-rt-punct-in-quote rt) rt))) - (lambda (x) (s-replace "ʼ" "’" x)))) - -(defun citeproc-rt--attr-values (r attr) - "Return the list of ATTR values in raw rich-text content R. -The values are ordered depth-first." - (if (listp r) - (let ((val (alist-get attr (car r))) - (body-vals (--mapcat (citeproc-rt--attr-values it attr) (cdr r)))) - (if val (cons val body-vals) - body-vals)) - nil)) - -(defun citeproc-rt-rendered-name-ids (r) - "Return the list of name ids in raw content R." - (citeproc-rt--attr-values r 'name-id)) - -(defun citeproc-rt-rendered-vars (r) - "Return the list of rendered vars in raw content R." - (citeproc-rt--attr-values r 'rendered-var)) - -(defun citeproc-rt-rendered-date-vars (r) - "Return the list of date vars in raw content R." - (--select (memq it citeproc--date-vars) (citeproc-rt-rendered-vars r))) - -(defun citeproc-rt-rendered-name-vars (r) - "Return the list of name vars in raw content R." - (--select (memq it citeproc--name-vars) (citeproc-rt-rendered-vars r))) - -;;; Helpers for bibliography rendering - -(defun citeproc-rt-max-offset (itemdata) - "Return the maximal first field width in rich-texts RTS." - (cl-loop for itd being the hash-values of itemdata - when (listp (citeproc-itemdata-rawbibitem itd)) maximize - (length (citeproc-rt-to-plain (cadr (citeproc-itemdata-rawbibitem itd)))))) - -(defun citeproc-rt-subsequent-author-substitute (bib s) - "Substitute S for subsequent author(s) in BIB. -BIB is a list of bib entries in rich-text format. Return the -modified bibliography." - (let (prev-author) - (--map - (let ((author - (citeproc-rt-find-first-node - it - (lambda (x) - (and (consp x) (assoc 'rendered-names (car x))))))) - (if (equal author prev-author) - (car (citeproc-rt-replace-first-names it s)) - (prog1 it (setq prev-author author)))) - bib))) - -(defun citeproc-rt-link-title (r target) - "Link the rendered title var in rich-text R to TARGET." - (cl-flet ((rendered-var-title-p - (node) - (and (consp node) - (eq (alist-get 'rendered-var (car node)) 'title))) - (add-link - (node) - (push (cons 'href target) (car node)))) - (citeproc-rt-transform-first r #'rendered-var-title-p #'add-link))) - -(defun citeproc-rt-locator-p (r) - "Return whether rich-text R is a rendered locator." - (and (consp r) (string= (alist-get 'rendered-var (car r)) "locator"))) - -(defun citeproc-rt-locator-label-p (r) - "Return whether rich-text R is a rendered locator label." - (and (consp r) (alist-get 'rendered-locator-label (car r)))) - -(defun citeproc-rt-add-locator-label-position (r) - "Add information about locator-label position in rich-text R. -Return value is one of `label', `locator', `label-first', -`locator-first', `label-only', `locator-only' or nil. This -information is also added to the tree node attributes." - (let ((result - (cond - ((not (consp r)) nil) - ((citeproc-rt-locator-p r) 'locator) - ((citeproc-rt-locator-label-p r) 'label) - (t (let ((content (cdr r)) - first second) - (while (and content (not (and first second))) - (let* ((cur (pop content)) - (cur-order (citeproc-rt-add-locator-label-position cur))) - (pcase cur-order - ('label-first (setq first 'label second 'locator)) - ('locator-first (setq first 'locator second 'label)) - ((or 'label-only 'label) - (if first (setq second 'label) - (setq first 'label))) - ((or 'locator-only 'locator) - (if first (setq second 'locator) - (setq first 'locator)))))) - (cond - ((not first) nil) - ((not second) (if (eq first 'locator) 'locator-only 'label-only)) - (t (if (eq first 'locator) 'locator-first 'label-first)))))))) - (when result (push (cons 'l-l-pos result) (car r))) - result)) - -(defun citeproc-rt-locator-w-label (r) - "Return locator with label if found from rich-text R. -Return R if no locator or locator label was found." - (let ((l-l-pos (citeproc-rt-add-locator-label-position r))) - (if l-l-pos - (citeproc-rt-locator-w-label-1 r l-l-pos) - ;; We return the full cite if no locator was found. - r))) - -(defun citeproc-rt-locator-w-label-1 (r l-l-pos) - "Return locator-label span from rich-text fragment R. -L-L-POS is the global position of locator and label, see the -documentation of `citeproc-rt-add-locator-label-position' for the -possible values." - (if (or (citeproc-rt-locator-label-p r) (citeproc-rt-locator-p r)) r - (pcase-let* ((`(,attrs . ,content) r) - (local-llpos (alist-get 'l-l-pos attrs))) - (cons attrs - (let (result - (n-boundaries (if (or (and (eq l-l-pos 'locator-first) - (eq local-llpos 'label-only)) - (and (eq l-l-pos 'label-first) - (eq local-llpos 'locator-only))) - 1 ; Fragment starts in a between position. - 0))) ; Fragment starts in a before position. - (while (and content (< n-boundaries 2)) - (let* ((cur-rt (pop content)) - (cur-rt-llpos (and (consp cur-rt) (alist-get 'l-l-pos (car cur-rt))))) - (cond (cur-rt-llpos - ;; Element at boundary - (cl-incf n-boundaries - (if (or (eq l-l-pos 'locator-only) - (memq cur-rt-llpos '(label-first locator-first))) - 2 - 1)) - (push (citeproc-rt-locator-w-label-1 cur-rt l-l-pos) result)) - ;; Element in between position, simply pushing - ((= n-boundaries 1) - (push cur-rt result))))) - (nreverse result)))))) - -(provide 'citeproc-rt) - -;;; citeproc-rt.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-s.el b/elpa/citeproc-20230228.1414/citeproc-s.el deleted file mode 100644 index bfb62083..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-s.el +++ /dev/null @@ -1,274 +0,0 @@ -;;; citeproc-s.el --- citeproc-el string functions -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; String utility functions for citeproc-el. - -;;; Code: - -(require 'thingatpt) -(require 's) - -;; Handle the unavailability of `string-replace' in early Emacs versions -(if (fboundp 'string-replace) - (defalias 'citeproc-s-replace #'string-replace) - (defalias 'citeproc-s-replace #'s-replace)) - -(defun citeproc-s-camelcase-p (s) - "Return whether string S is in camel case." - (let ((case-fold-search nil)) - (and (< 1 (length s)) - (s-matches-p "[[:upper:]]" (substring s 1)) - (s-matches-p "[[:lower:]]" s)))) - -(defun citeproc-s-fill-copy (s1 s2) - "Return a copy of string S1 filled by characters from string S2. -If string S1 is shorter than string S2 then prepend enough -characters from to beginning of S2 to the beginning of a copy of -S2 to make their length equal, and return the filled copy." - (if (>= (length s1) (length s2)) s1 - (concat (substring s2 0 (- (length s2) (length s1))) s1))) - -(defun citeproc-s-fill-left-to-len (s len &optional char) - "Fill string S to length LEN with CHAR from left." - (let ((len-s (length s)) - (char (or char ?0))) - (if (>= len-s len) s - (concat (make-string (- len len-s) char) s)))) - -(defun citeproc-s-nil-or-s-to-num (s) - "Convert S, which is a string or nil to a number. -A nil value is converted to 0." - (if s (string-to-number s) 0)) - -(defun citeproc-s-from-num-or-s (x) - "Return the content of string or number X as a number." - (if (numberp x) (number-to-string x) x)) - -(defun citeproc-s-content (s) - "Return the string content of string or symbol or nil S. -The string content of nil is defined as \"\"." - (pcase s - ((\` nil) "") - ((pred symbolp) (symbol-name s)) - (_ s))) - -(defun citeproc-s-slice-by-matches (s regexp &optional start annot) - "Slice S up at the boundaries of each REGEXP match. -Optionally start from index START. Matches are also included -among the slices, but all zero-length slices are omitted. If -optional ANNOT is non-nil then slices are given as (S . B) cons -cells where S is the slice string, while B is nil if the S slice -is a separating REGEXP match and t otherwise." - (unless start (setq start 0)) - (save-match-data - (let ((begin (string-match regexp s start))) - (if begin - (let ((end (match-end 0))) - (if (and (= begin start) (= end start)) - (citeproc-s-slice-by-matches s regexp (1+ start) annot) - (let ((result (citeproc-s-slice-by-matches (substring s end) - regexp 0 annot))) - (unless (= begin end) - (let ((slice (substring s begin end))) - (push (if annot (list slice) slice) result))) - (unless (= 0 begin) - (let ((slice (substring s 0 begin))) - (push (if annot (cons slice t) slice) result))) - result))) - (list (if annot (cons s t) s)))))) - -(defun citeproc-s-tail (s length) - "Return the closing substring of string S with length LENGTH. -Return S if LENGTH is nil or not less than the length of S." - (let ((l (length s))) - (if (and length (< length l)) - (substring s (- l length)) - s))) - -(defun citeproc-s-capitalize-first (s) - "Capitalize the first word in string S. -Return the capitalized version of S. If S contains no word or the -first word is not in lowercase then return S." - (if (s-present-p s) - (with-temp-buffer - (insert s) - (goto-char 1) - (forward-word) - (backward-word) - (let ((word (word-at-point))) - (when (s-lowercase-p word) - (capitalize-word 1))) - (buffer-string)) - s)) - -(defun citeproc-s-capitalize-all (s) - "Capitalize all lowercase words in string S. -Return the capitalized version of S. If S contains no word or the -first word is not in lowercase then return S." - (if (s-present-p s) - (with-temp-buffer - (insert s) - (goto-char 1) - (while (forward-word) - (let ((word (word-at-point))) - (when (s-lowercase-p word) - (capitalize-word -1)))) - (buffer-string)) - s)) - -(defun citeproc-s-sentence-case (s) - "Return a sentence-cased version of string S." - (if (s-present-p s) - (with-temp-buffer - (insert s) - (goto-char 1) - (let ((first t)) - (while (forward-word) - (let ((word (word-at-point))) - (cond ((s-uppercase-p word) (capitalize-word -1)) - ((and first (s-lowercase-p word)) (capitalize-word -1)))) - (when first (setq first nil)))) - (buffer-string)) - s)) - -(defun citeproc-s-sentence-case-title (s omit-nocase) - "Return a sentence-cased version of title string S. -If optional OMIT-NOCASE is non-nil then omit the nocase tags from the output." - (if (s-blank-p s) s - (let ((sliced (citeproc-s-slice-by-matches - s "\\(\\|\\|: +\\w\\)")) - (protect-level 0) - (first t) - result) - (dolist (slice sliced) - (push - (pcase slice - ("" (cl-incf protect-level) (if omit-nocase nil slice)) - ("" (cl-decf protect-level) (if omit-nocase nil slice)) - ;; Don't touch the first letter after a colon since it is probably a subtitle. - ((pred (string-match-p "^:")) slice) - (_ (cond ((< 0 protect-level) (setq first nil) slice) - ((not first) (downcase slice)) - (t (setq first nil) - (concat (upcase (substring slice 0 1)) - (downcase (substring slice 1))))))) - result)) - (apply #'concat (nreverse result))))) - -(defconst citeproc-s-english-stopwords - '("a" "according to" "across" "afore" "after" "against" "ahead of" "along" "alongside" - "amid" "amidst" "among" "amongst" "an" "and" "anenst" "apart from" "apropos" - "around" "as" "as regards" "aside" "astride" "at" "athwart" "atop" "back to" - "barring" "because of" "before" "behind" "below" "beneath" "beside" "besides" - "between" "beyond" "but" "by" "c" "ca" "circa" "close to" "d'" "de" "despite" "down" - "due to" "during" "et" "except" "far from" "for" "forenenst" "from" "given" "in" - "inside" "instead of" "into" "lest" "like" "modulo" "near" "next" "nor" "of" "off" - "on" "onto" "or" "out" "outside of" "over" "per" "plus" "prior to" "pro" "pursuant - to" "qua" "rather than" "regardless of" "sans" "since" "so" "such as" "than" - "that of" "the" "through" "throughout" "thru" "thruout" "till" "to" "toward" "towards" - "under" "underneath" "until" "unto" "up" "upon" "v." "van" "versus" "via" "vis-à-vis" - "von" "vs." "where as" "with" "within" "without" "yet")) - -(defun citeproc-s-title-case (s) - "Return a title-cased version of string S." - (if (s-present-p s) - (with-temp-buffer - (insert s) - (goto-char 1) - (let ((first t) - after-colon) - (while (forward-word) - (let ((word (word-at-point))) - (cond ((and (not (or first after-colon)) - (member (downcase word) citeproc-s-english-stopwords) - ;; Don't downcase A before a period: - (or (not (string= word "A")) - (= (point) (point-max)) - (/= (char-after) ?.))) - (downcase-word -1)) - ((s-lowercase-p word) - (capitalize-word -1)))) - (when first (setq first nil)) - (when (< (point) (point-max)) - (setq after-colon (or (= (char-after) ?:) - (= (char-after) ?.)))))) - (buffer-string)) - s)) - -(defun citeproc-s-smart-quotes (s oq cq) - "Replace dumb quotes in string S with smart ones OQ and CQ. -OQ is the opening quote, CQ is the closing quote to use." - (with-temp-buffer - (insert s) - (goto-char 1) - (while (search-forward "\"" nil 1) - (let ((w-a-p (word-at-point))) - (delete-char -1) - (insert (if w-a-p oq cq)))) - (buffer-string))) - -(defun citeproc-s-replace-all-seq (s replacements) - "Make replacements in S according to REPLACEMENTS sequentially. -REPLACEMENTS is an alist with (FROM . TO) elements." - (let ((result s)) - (pcase-dolist (`(,from . ,to) replacements) - (setq result (citeproc-s-replace from to result))) - result)) - -(defun citeproc-s-replace-all-sim (s regex replacements) - "Replace all matches of REGEX in S according to REPLACEMENTS simultaneously. -REPLACEMENTS is an alist with (FROM . TO) elements." - (replace-regexp-in-string regex - (lambda (match) (cdr (assoc-string match replacements))) - s t t)) - -(defun citeproc-s-smart-apostrophes (s) - "Replace dumb apostophes in string S with smart ones. -The replacement character used is the unicode character `modifier -letter apostrophe'." - (subst-char-in-string ?' ?ʼ (subst-char-in-string ?’ ?ʼ s t) t)) - -(defconst citeproc-s--cull-spaces-alist - '((" " . " ") (";;" . ";") ("..." . ".") (",," . ",") (".." . ".")) - "Alist describing replacements for space and punct culling.") - -(defconst citeproc-s--cull-spaces-alist-rx - (regexp-opt (mapcar #'car citeproc-s--cull-spaces-alist))) - -(defun citeproc-s-cull-spaces-puncts (s) - "Replace unnecessary characters with delete chars in string S." - (let ((result (citeproc-s-replace-all-seq s citeproc-s--cull-spaces-alist))) - (dolist (match-rep '(("\\([:;!?]\\):" . "\\1") - ("\\([:.;!?]\\)\\." . "\\1") - ("\\([:;!]\\)!" . "!") - ("\\([:;?]\\)\\?" . "?") - ("\\.\\([”’‹›«»]\\)\\." . ".\\1") - (",\\([”’‹›«»]\\)," . ",\\1")) - result) - (setq result (replace-regexp-in-string (car match-rep) - (cdr match-rep) - result))))) - -(provide 'citeproc-s) - -;;; citeproc-s.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-sort.el b/elpa/citeproc-20230228.1414/citeproc-sort.el deleted file mode 100644 index 12bdb685..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-sort.el +++ /dev/null @@ -1,191 +0,0 @@ -;;; citeproc-sort.el --- cite and bibliography sorting -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to sort cites and bibliography items. - -;;; Code: - -(require 'subr-x) -(require 'cl-lib) -(require 'dash) -(require 's) - -(require 'citeproc-lib) -(require 'citeproc-s) -(require 'citeproc-rt) -(require 'citeproc-macro) -(require 'citeproc-proc) -(require 'citeproc-name) - -(defun citeproc--sort (_attrs _context &rest body) - "Placeholder function corresponding to the cs:sort element of CSL." - body) - -(defun citeproc-sort--name-var-key (var context) - "Return the sort-key for name-var VAR using CONTEXT. -VAR is a CSL name-var name as a symbol. The returned value is a -string containing a semicolon-separated list of all full names in -sort order." - (citeproc-rt-to-plain - (citeproc-rt-render-affixes - (citeproc-name--render-var var '((form . "long") (name-as-sort-order . "all") - (et-al-min . nil) (et-al-use-first . "0") - (delimiter . "; ")) - nil nil nil nil nil context)))) - -(defun citeproc-sort--date-as-key (d _context) - "Render D citeproc-date struct as a sort key." - (if d (let ((year (citeproc-date-year d)) - (month (or (citeproc-date-month d) 0)) - (day (or (citeproc-date-day d) 0))) - ;; We add 5000 as an offset to deal with sorting BC years properly - (concat (number-to-string (+ 5000 year)) - (citeproc-s-fill-left-to-len (number-to-string month) 2 ?0) - (citeproc-s-fill-left-to-len (number-to-string day) 2 ?0))) - "")) - -(defun citeproc-sort--date-var-key (var context) - "Return the sort-key for name-var VAR using CONTEXT. -VAR is a symbol." - (-let* (((d1 d2) (citeproc-var-value var context)) - (rendered-first (citeproc-sort--date-as-key d1 context))) - (if d2 - (concat rendered-first "–" (citeproc-sort--date-as-key d2 context)) - rendered-first))) - -(defun citeproc--key (attrs context &rest _body) - "Return a sort key corresponding to ATTRS and CONTEXT." - (-let (((&alist 'macro macro - 'variable var) - attrs) - (global-attrs (--filter (memq (car it) - '(names-min names-use-first names-use-last)) - attrs))) - (if var (let ((var-sym (intern var))) - (cond - ((memq var-sym citeproc--number-vars) - ;; OPTIMIZE: This is way too complicated to simply get a filled - ;; numeric value.. - (citeproc-s-fill-left-to-len - (citeproc-number-var-value - (citeproc-var-value var-sym context) var-sym 'numeric context) - 5)) - ((memq var-sym citeproc--date-vars) - (citeproc-sort--date-var-key var-sym context)) - ((memq var-sym citeproc--name-vars) - (citeproc-sort--name-var-key var-sym context)) - (t (citeproc-rt-to-plain (citeproc-var-value var-sym context))))) - (let ((new-context (citeproc-context--create - :vars (citeproc-context-vars context) - :macros (citeproc-context-macros context) - :terms (citeproc-context-terms context) - :date-text (citeproc-context-date-text context) - :date-numeric (citeproc-context-date-numeric context) - :opts (nconc global-attrs (citeproc-context-opts context)) - :mode (citeproc-context-mode context) - :render-mode 'sort - :render-year-suffix nil))) - (citeproc-macro-output-as-text macro new-context))))) - -(defun citeproc-sort--compare-keys (k1 k2 &optional desc) - "Return 1, 0 or -1 depending on the sort-order of keys K1 and K2. -If optional DESC is non-nil then reverse the comparison for -descending sort." - (cond ((string-collate-equalp k1 k2) 0) - ((s-blank? k1) -1) - ((s-blank? k2) 1) - (t (* (if (string-collate-lessp k1 k2) 1 -1) - (if desc -1 1))))) - -(defun citeproc-sort--compare-keylists (k1 k2 sort-orders) - "Whether keylist K1 precedes keylist K2 in the sort order. -SORT-ORDERS is a list of sort orders to use (see the bib- and -cite-sort-orders slots of `citeproc-style' for details)." - (citeproc-lib-lex-compare k1 k2 #'citeproc-sort--compare-keys sort-orders)) - -(defun citeproc-sort--render-keys (style var-alist mode) - "Render the sort keys of an item with STYLE and VAR-ALIST. -MODE is either `cite' or `bib'." - (let ((context (citeproc-context-create var-alist style mode 'sort)) - (sort (cl-ecase mode - (cite (citeproc-style-cite-sort style)) - (bib (citeproc-style-bib-sort style))))) - (if sort (funcall sort context) nil))) - -(defun citeproc-itd-update-sortkey (itd style) - "Update the sort key of itemdata ITD for STYLE." - (setf (citeproc-itemdata-sort-key itd) - (citeproc-sort--render-keys style (citeproc-itemdata-varvals itd) 'bib))) - -(defun citeproc-proc-update-sortkeys (proc) - "Update all sort keys of the itemdata in PROC." - (let ((style (citeproc-proc-style proc)) - (itds (citeproc-proc-itemdata proc))) - (maphash (lambda (_id itd) - (citeproc-itd-update-sortkey itd style)) - itds))) - -(defun citeproc-sort-itds-on-citnum (itds) - "Sort itemdata struct list ITDS according to citation number." - (sort itds - (lambda (x y) - (< (string-to-number (citeproc-itd-getvar x 'citation-number)) - (string-to-number (citeproc-itd-getvar y 'citation-number)))))) - -(defun citeproc-sort-itds-on-subbib (itd1 itd2) - "Sort itemdata structs ITD1 ITD2 according to subbib order." - (let ((idx1 (car (citeproc-itemdata-subbib-nos itd1))) - (idx2 (car (citeproc-itemdata-subbib-nos itd2)))) - (and idx1 - (or (null idx2) (< idx1 idx2))))) - -(defun citeproc-sort-itds (itds sort-orders) - "Sort the itemdata struct list ITDS according to SORT-ORDERS." - (sort itds - (lambda (x y) - (citeproc-sort--compare-keylists (citeproc-itemdata-sort-key x) - (citeproc-itemdata-sort-key y) - sort-orders)))) - -(defun citeproc-proc-sort-itds (proc) - "Sort the itemdata in PROC." - (let ((is-sorted-bib (citeproc-style-bib-sort (citeproc-proc-style proc))) - (is-filtered (citeproc-proc-filtered-bib-p proc))) - (when (or is-sorted-bib is-filtered) - (let* ((itds (hash-table-values (citeproc-proc-itemdata proc))) - (sorted (if is-sorted-bib - (let ((sort-orders (citeproc-style-bib-sort-orders - (citeproc-proc-style proc)))) - (citeproc-sort-itds itds sort-orders)) - (citeproc-sort-itds-on-citnum itds)))) - ;; Additionally sort according to subbibliographies if there are filters. - (when is-filtered - (setq sorted (sort sorted #'citeproc-sort-itds-on-subbib))) - ;; Set the CSL citation-number field according to the sort order. - (--each-indexed sorted - (citeproc-itd-setvar it 'citation-number - (number-to-string (1+ it-index)))))))) - -(provide 'citeproc-sort) - -;;; citeproc-sort.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-style.el b/elpa/citeproc-20230228.1414/citeproc-style.el deleted file mode 100644 index e7dd4c78..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-style.el +++ /dev/null @@ -1,344 +0,0 @@ -;; citeproc-style.el --- CSL style structure and related functions -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Structure type and functions for constructing and accessing CSL style -;; objects. - -;;; Code: - -(require 'subr-x) -(require 'let-alist) -(require 'dash) -(require 'cl-lib) -(require 's) - -(require 'citeproc-lib) -(require 'citeproc-locale) - -(cl-defstruct (citeproc-style (:constructor citeproc-style--create)) - "A struct representing a parsed and localized CSL style. -INFO is the style's general info (currently simply the - corresponding fragment of the parsed xml), -OPTS, BIB-OPTS, CITE-OPTS and LOCALE-OPTS are alists of general - and bibliography-, cite- and locale-specific CSL options, -BIB-SORT, BIB-LAYOUT, CITE-SORT and CITE-LAYOUT are anonymous - functions for calculating sort-keys and rendering, -BIB-SORT-ORDERS and CITE-SORT-ORDERS are the lists of sort orders - for bibliography and cite sort (the value is a list containg t - or nil as its n-th element depending on whether the sort for on - the n-th key should be in ascending or desending order, -CITE-LAYOUT-ATTRS contains the attributes of the citation layout - as an alist, -CITE-NOTE is non-nil iff the style's citation-format is \"note\", -DATE-TEXT and DATE-NUMERIC are the style's date formats, -LOCALE contains the locale to be used or nil if not set, -MACROS is an alist with macro names as keys and corresponding - anonymous rendering functions, -TERMS is the style's parsed term-list, -USES-YS-VAR is non-nil iff the style uses the YEAR-SUFFIX - CSL-variable." - info opts bib-opts bib-sort bib-sort-orders - bib-layout cite-opts cite-note cite-sort cite-sort-orders - cite-layout cite-layout-attrs locale-opts macros terms - uses-ys-var date-text date-numeric locale) - -(defun citeproc-style-parse (style) - "Return the parsed representation of csl STYLE. -STYLE is either a path to a style file or a style as a string. -Returns a (YEAR-SUFF-P . PARSED-STYLE) cons cell. YEAR-SUFF-P is -non-nil if the style uses the `year-suffix' csl var; PARSED-STYLE -is the parsed form of the xml STYLE-FILE." - (let ((xml-input (s-matches-p " ?<" style))) - (with-temp-buffer - (let ((case-fold-search t)) - (if xml-input (insert style) - (insert-file-contents style)) - (goto-char 1) - (cons (re-search-forward "variable=\"year-suffix\"" nil t) - (citeproc-lib-remove-xml-comments - (libxml-parse-xml-region (point-min) (point-max)))))))) - -;; TODO: Parse and store info in a more structured and sensible form. Also, -;; currently the first in-style locale is loaded that is compatible with the -;; locale to be used. In theory, there may be more than one compatible in-style -;; locales that should be merged in an order reflecting their closeness to the -;; requested locale. -(defun citeproc-create-style-from-locale (parsed-style year-suffix locale) - "Create a citation style from parsed xml style PARSED-STYLE. -YEAR-SUFFIX specifies whether the style explicitly uses the -`year-suffix' csl variable. LOCALE is the locale for which -in-style locale information will be loaded (if available)." - (let* ((style (citeproc-style--create)) - (style-opts (cadr parsed-style)) - locale-loaded) - (setf (citeproc-style-opts style) style-opts - (citeproc-style-uses-ys-var style) year-suffix - (citeproc-style-locale style) - (or locale (alist-get 'default-locale style-opts))) - (--each (cddr parsed-style) - (pcase (car it) - ('info - (let ((info-lst (cddr it))) - (setf (citeproc-style-info style) info-lst - (citeproc-style-cite-note style) - (not (not (member '(category - ((citation-format . "note"))) - info-lst)))))) - ('locale - (let ((lang (alist-get 'lang (cadr it)))) - (when (and (citeproc-locale--compatible-p lang locale) - (not locale-loaded)) - (citeproc-style--update-locale style it) - (setq locale-loaded t)))) - ('citation - (citeproc-style--update-cite-info style it)) - ('bibliography - (citeproc-style--update-bib-info style it)) - ('macro - (citeproc-style--update-macros style it)))) - style)) - -(defun citeproc-style--parse-layout-and-sort-frag (frag) - "Parse a citation or bibliography style xml FRAG. -Return an alist with keys `layout', `opts', `layout-attrs', `sort' -and `sort-orders'." - (let* ((opts (cadr frag)) - (sort-p (eq (cl-caaddr frag) 'sort)) - (layout (citeproc-style--transform-xmltree - (elt frag (if sort-p 3 2)))) - (layout-attrs (cl-cadadr (cl-caddr layout))) - sort sort-orders) - (when sort-p - (let* ((sort-frag (cl-caddr frag))) - (setq sort (citeproc-style--transform-xmltree sort-frag) - sort-orders (--map (not (string= "descending" (alist-get 'sort (cadr it)))) - (cddr sort-frag))))) - `((opts . ,opts) (layout . ,layout) (layout-attrs . ,layout-attrs) - (sort . ,sort) (sort-orders . ,sort-orders)))) - -(defun citeproc-style--update-cite-info (style frag) - "Update the cite info of STYLE on the basis of its parsed FRAG." - (let-alist (citeproc-style--parse-layout-and-sort-frag frag) - (setf (citeproc-style-cite-opts style) .opts - (citeproc-style-cite-layout style) .layout - (citeproc-style-cite-layout-attrs style) .layout-attrs - (citeproc-style-cite-sort style) .sort - (citeproc-style-cite-sort-orders style) .sort-orders))) - -(defun citeproc-style--update-bib-info (style frag) - "Update the bib info of STYLE on the basis of its parsed FRAG." - (let-alist (citeproc-style--parse-layout-and-sort-frag frag) - (setf (citeproc-style-bib-opts style) .opts - (citeproc-style-bib-layout style) .layout - (citeproc-style-bib-sort style) .sort - (citeproc-style-bib-sort-orders style) .sort-orders))) - -(defun citeproc-style--update-macros (style frag) - "Update the macro info of STYLE on the basis of its parsed FRAG." - (let ((name (cl-cdaadr frag))) - (setf (car frag) 'macro) - (setf (cadr frag) nil) - (push (cons name (citeproc-style--transform-xmltree frag)) - (citeproc-style-macros style)))) - -(defun citeproc-style--update-locale (style frag) - "Update locale info in STYLE using xml fragment FRAG. -FRAG should be a parsed locale element from a style or a locale." - (--each (cddr frag) - (pcase (car it) - ('style-options (setf (citeproc-style-locale-opts style) - (-concat (citeproc-style-locale-opts style) - (cadr it)))) - ('date - (citeproc-style--update-locale-date style it)) - ('terms - (let ((parsed-terms (citeproc-locale-termlist-from-xml-frag (cddr it)))) - (setf (citeproc-style-terms style) - (if (citeproc-style-terms style) - (citeproc-term-list-update parsed-terms (citeproc-style-terms style)) - parsed-terms))))))) - -(defun citeproc-style--update-locale-date (style frag) - "Update date info in STYLE using xml fragment FRAG. -FRAG should be a parsed locale element from a style or a locale." - (let* ((date-attrs (cadr frag)) - (form (alist-get 'form date-attrs)) - (date-format (cons date-attrs - (citeproc-lib-named-parts-to-alist frag)))) - (if (string= form "text") - (unless (citeproc-style-date-text style) - (setf (citeproc-style-date-text style) date-format)) - (unless (citeproc-style-date-numeric style) - (setf (citeproc-style-date-numeric style) date-format))))) - -(defconst citeproc-style--opt-defaults - '((cite-opts near-note-distance "5") - (locale-opts punctuation-in-quote "false") - (locale-opts limit-day-ordinals-to-day-1 "false") - (bib-opts hanging-indent "false") - (bib-opts line-spacing "1") - (bib-opts entry-spacing "1") - (opts initialize-with-hyphen "true") - (opts demote-non-dropping-particle "display-and-sort")) - "Global style options. -Specified as a list of (STYLE-SLOT OPTION-NAME OPTION-DEFAULT) -lists. - -Note: Collapse-related options are not specified here since their -default settings are interdependent.") - -(defun citeproc-style--set-opt (style opt-slot opt value) - "Set OPT in STYLE's OPT-SLOT to VALUE." - (setf (cl-struct-slot-value 'citeproc-style opt-slot style) - (cons (cons opt value) - (cl-struct-slot-value 'citeproc-style opt-slot style)))) - -(defun citeproc-style--set-opt-defaults (style) - "Set missing options of STYLE to their default values." - (cl-loop - for (slot option value) in citeproc-style--opt-defaults do - (let ((slot-value (cl-struct-slot-value 'citeproc-style slot style))) - (unless (alist-get option slot-value) - (setf (cl-struct-slot-value 'citeproc-style slot style) - (cons (cons option value) slot-value))))) - (let* ((cite-opts (citeproc-style-cite-opts style)) - (collapse (alist-get 'collapse cite-opts))) - (when (and collapse (not (string= collapse "citation-number"))) - (let ((cite-layout-dl - (alist-get 'delimiter (citeproc-style-cite-layout-attrs style))) - (cite-group-dl - (alist-get 'cite-group-delimiter cite-opts))) - (unless cite-group-dl - (citeproc-style--set-opt style 'cite-opts 'cite-group-delimiter ", ")) - (unless (alist-get 'after-collapse-delimiter cite-opts) - (citeproc-style--set-opt - style 'cite-opts 'after-collapse-delimiter cite-layout-dl)) - (when (and (member collapse '("year-suffix" "year-suffix-ranged")) - (null (alist-get 'year-suffix-delimiter cite-opts))) - (citeproc-style--set-opt - style 'cite-opts 'year-suffix-delimiter cite-layout-dl)))))) - -(defun citeproc-style--transform-xmltree (tree) - "Transform parsed csl xml fragment TREE into a lambda." - `(lambda (context) ,(citeproc-style--transform-xmltree-1 tree))) - -(defun citeproc-style--transform-xmltree-1 (tree) - "Transform parsed xml fragment TREE into an eval-able form. -Symbols in car position are prefixed with `citeproc--' and the -symbol `context' is inserted everywhere after the second (attrs) -position and before the (possibly empty) body." - (pcase tree - ((pred atom) tree) - (`(names . ,_) (citeproc-style--transform-names tree)) - (_ - `(,(intern (concat "citeproc--" (symbol-name (car tree)))) - ,(list 'quote (cadr tree)) - context - ,@(mapcar #'citeproc-style--transform-xmltree-1 (cddr tree)))))) - -(defun citeproc-style--transform-names (frag) - "Transform the content of a cs:names CSL element xml FRAG." - (let* ((names-attrs (cadr frag)) - (body (-remove #'stringp (cddr frag))) - (vars (alist-get 'variable names-attrs)) - substs name-attrs name-parts et-al-attrs - is-label label-attrs label-before-names) - (--each body - (pcase (car it) - ('name - (setq name-attrs (cadr it) - name-parts (citeproc-lib-named-parts-to-alist it) - label-before-names t)) - ('et-al - (setq et-al-attrs (cadr it))) - ('label - (setq is-label t - label-attrs (cadr it) - label-before-names nil)) - ('substitute - (setq substs - (mapcar - (lambda (x) - (if (eq (car x) 'names) - `(citeproc-name-render-vars - ,(alist-get 'variable (cadr x)) - names-attrs name-attrs name-parts et-al-attrs - is-label label-before-names label-attrs context) - (citeproc-style--transform-xmltree-1 x))) - (cddr it)))))) - `(if (citeproc-var-value 'suppress-author context) (cons nil 'empty-vars) - (let* ((names-attrs ',names-attrs) - (name-attrs ',name-attrs) - (count (string= (alist-get 'form name-attrs) "count")) - (et-al-attrs ',et-al-attrs) - (name-parts ',name-parts) - (label-attrs ',label-attrs) - (is-label ,is-label) - (label-before-names ,label-before-names) - (val (citeproc-name-render-vars - ,vars names-attrs name-attrs name-parts et-al-attrs - is-label label-before-names label-attrs context)) - (result (if (car val) - val - (-if-let ((cont . type) (--first (car it) - (list ,@substs))) - (cons (cons (list '(subst . t)) (list cont)) type) - (cons nil 'empty-vars)))) - (final (if count - (let* ((number (citeproc-rt-count-names (car result))) - (str (if (= 0 number) "" (number-to-string number)))) - (cons str (cdr result))) - result))) - ;; Handle `author' citation mode by stopping if needed - (citeproc-lib-maybe-stop-rendering 'names context final))))) - -(defun citeproc-style-global-opts (style layout) - "Return the global opts in STYLE for LAYOUT. -LAYOUT is either `bib' or `cite'." - (-concat (cl-ecase layout - (bib (citeproc-style-bib-opts style)) - (cite (citeproc-style-cite-opts style))) - (citeproc-style-opts style))) - -(defun citeproc-style-bib-opts-to-formatting-params (bib-opts) - "Convert BIB-OPTS to a formatting parameters alist." - (let ((result - (cl-loop - for (opt . val) in bib-opts - if (memq opt - '(hanging-indent line-spacing entry-spacing second-field-align)) - collect (cons opt - (pcase val - ("true" t) - ("false" nil) - ("flush" 'flush) - ("margin" 'margin) - (_ (string-to-number val))))))) - (if (alist-get 'second-field-align result) - result - (cons (cons 'second-field-align nil) - result)))) - -(provide 'citeproc-style) - -;;; citeproc-style.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-subbibs.el b/elpa/citeproc-20230228.1414/citeproc-subbibs.el deleted file mode 100644 index 4379e676..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-subbibs.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; citeproc-subbibs.el --- support for subbibliographies -*- lexical-binding: t; -*- - -;; Copyright (C) 2021-2022 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Support for generating subbibliographies based on filtering items. - -;;; Code: - -(require 'dash) - -(require 'citeproc-proc) -(require 'citeproc-itemdata) - -(defun citeproc-sb--match-p (vv filter) - "Return whether var-vals alist VV matches all conditions in FILTER. -FILTER should be an alist containing symbol keys and string -values, each pair describing an atomic condition to be -satisified. For a list and description of the supported keys -see the documentation of `citeproc-add-subbib-filters'." - (let* ((csl-type (alist-get 'type vv)) - (type (or (alist-get 'blt-type vv) csl-type)) - (keyword (alist-get 'keyword vv)) - (keywords (and keyword (split-string keyword "[ ,;]" t)))) - (--every-p - (pcase it - (`(type . ,key) (string= type key)) - (`(nottype . ,key) (not (string= type key))) - (`(keyword . ,key) (member key keywords)) - (`(notkeyword . ,key) (not (member key keywords))) - (`(filter . ,key) (funcall (intern key) vv)) - (`(csltype . ,key) (string= csl-type key)) - (`(notcsltype . ,key) (not (string= csl-type key))) - (`(,key . ,_) (error "Unsupported Citeproc filter keyword `%s'" key))) - filter))) - -(defun citeproc-sb-add-subbib-info (proc) - "Add subbibliography information to the items in PROC." - (when (citeproc-proc-filtered-bib-p proc) - (let ((filters (citeproc-proc-bib-filters proc))) - (maphash - (lambda (_ itemdata) - (let* ((varvals (citeproc-itemdata-varvals itemdata)) - (subbib-nos - (-non-nil - (--map-indexed - (when (citeproc-sb--match-p varvals it) it-index) - filters)))) - (setf (citeproc-itemdata-subbib-nos itemdata) subbib-nos))) - (citeproc-proc-itemdata proc))))) - -(defun citeproc-sb-prune-unrendered (proc) - "Remove all itemdata about unrendered items from PROC. -An item is unrendered if -- there are subbibfilters but none of them matches it, and -- it is not cited." - (when (citeproc-proc-filtered-bib-p proc) - (let ((itemdata (citeproc-proc-itemdata proc))) - (maphash - (lambda (id data) - (when (and (citeproc-itemdata-uncited data) - (null (citeproc-itemdata-subbib-nos data))) - (remhash id itemdata))) - itemdata)))) - -(provide 'citeproc-subbibs) - -;;; citeproc-subbibs.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-term.el b/elpa/citeproc-20230228.1414/citeproc-term.el deleted file mode 100644 index ce9bbaf0..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-term.el +++ /dev/null @@ -1,113 +0,0 @@ -;;; citeproc-term.el --- functions for term localization -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions for localizing the terms of a CSL style according to a locale. - -;;; Code: - -(require 'dash) -(require 'cl-lib) -(require 'let-alist) - -(require 'citeproc-lib) -(require 'citeproc-s) - -(cl-defstruct (citeproc-term (:constructor citeproc-term--create)) - "A struct representing a localized term." - (name nil) (form nil) (number nil) (gender nil) (gender-form nil) - (match nil) (text nil)) - -(defun citeproc-term--compare (t1 t2) - "Compare terms T1 and T2. -The comparison is based on the term fields except the last one, -and relies on the alphabetical ordering of fields' string -content (see the function `citeproc-lib-s-content'). Return 1, -1 -or 0 iff T1 precedes, succeeds or is equal according to the -ordering." - (cond ((not t2) 1) - ((not t1) -1) - (t (let ((idx 1) - (result 0)) - (while (and (= result 0) (< idx 7)) - (let ((s1 (citeproc-s-content (aref t1 idx))) - (s2 (citeproc-s-content (aref t2 idx)))) - (cond ((string< s1 s2) (setq result 1)) - ((string> s1 s2) (setq result -1)))) - (cl-incf idx)) result)))) - -(defun citeproc-term-list--sort (tl) - "Sort termlist TL in place using `citeproc-term--compare'." - (cl-sort tl (lambda (x y) (> (citeproc-term--compare x y) -1)))) - -(defun citeproc-term-list-update (tl1 tl2 &optional sorted-input) - "Return a term list which is TL1 updated with term list TL2. -TL1 and TL2 are list of citeproc-term structs. The order of terms -in the returned term list is undetermined. If the optional -SORTED-INPUT is non-nil then the term lists are supposed to be -already sorted according to `citeproc-term--compare', otherwise -they are sorted in-place." - (let (result) - (unless sorted-input - (setq tl1 (citeproc-term-list--sort tl1) - tl2 (citeproc-term-list--sort tl2))) - (while (or tl1 tl2) - (let* ((t1 (car tl1)) - (t2 (car tl2)) - (cmp (citeproc-term--compare t1 t2))) - (cond ((= cmp 1) (push t1 result) (pop tl1)) - ((= cmp -1) (push t2 result) (pop tl2)) - (t (push t2 result) (pop tl1) (pop tl2))))) - result)) - -(defun citeproc-term--from-xml-frag (frag) - "Transform xml FRAG representing a term into a citeproc-term struct." - (let-alist (car frag) - (-let* ((.form (or .form "long")) - (term (citeproc-term--create - :name .name - :form (citeproc-lib-intern .form) - :gender (citeproc-lib-intern .gender) - :match (citeproc-lib-intern .match) - :gender-form (citeproc-lib-intern .gender-form)))) - (if (= (length frag) 2) - (progn - (setf (citeproc-term-text term) (cadr frag)) - (list term)) - (setf (citeproc-term-text term) (cl-caddr (cadr frag))) - (setf (citeproc-term-number term) 'single) - (let ((multi-term (copy-citeproc-term term))) - (setf (citeproc-term-text multi-term) (cl-caddr (cl-caddr frag))) - (setf (citeproc-term-number multi-term) 'multiple) - (list term multi-term)))))) - -(defun citeproc-term-text-from-terms (term terms) - "Return the first text associated with TERM in TERMS. -Return nil if TERM is not in TERMS." - (-if-let (match (--first (string= term (citeproc-term-name it)) - terms)) - (citeproc-term-text match) - nil)) - -(provide 'citeproc-term) - -;;; citeproc-term.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc-test-human.el b/elpa/citeproc-20230228.1414/citeproc-test-human.el deleted file mode 100644 index 202e5e1f..00000000 --- a/elpa/citeproc-20230228.1414/citeproc-test-human.el +++ /dev/null @@ -1,207 +0,0 @@ -;; citeproc-test-human.el --- support tests in CSL suite format -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2021 András Simonyi - -;; Author: András Simonyi - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Functions to create ERT tests from tests in CSL test suite format. The -;; official tests can be found at -;; . - -;;; Code: - -(require 'f) -(require 's) -(require 'json) -(require 'ert) -(require 'string-inflection) - -(require 'citeproc) - -(defvar citeproc-test-human--locale-dir "./test/locales") - -(defun citeproc-test-human--parse-testfile (file) - "Return a parsed form of CSL test FILE." - (let (result - (json-array-type 'list) - (json-key-type 'symbol)) - (with-temp-buffer - (insert-file-contents file) - (goto-char 1) - (setq result (list (cons 'YEAR-SUFF - (re-search-forward "variable=\"year-suffix\"" nil t)))) - (goto-char 1) - (while (re-search-forward ">>=+ \\{1,2\\}\\([[:graph:]]+\\) =+>>" nil t) - (let ((section (intern (buffer-substring (nth 2 (match-data)) - (nth 3 (match-data))))) - (start (1+ (point))) - end) - (re-search-forward "<<=" nil t) - (setq end (- (car (match-data)) 1)) - (push (cons section (pcase section - ('OUTPUT-FORMAT - (intern (buffer-substring-no-properties start end))) - ('CSL (buffer-substring-no-properties start end)) - ((or 'INPUT 'CITATIONS 'CITATION-ITEMS) - (goto-char (- start 1)) (json-read)) - (_ (buffer-substring start end)))) - result)))) - result)) - -(defun citeproc-test-human--create-getter (items) - "Return a getter function for ITEMS. -ITEMS is the parsed representation of the `INPUT' section of a -CSL test." - (lambda (itemids) - (let (result) - (dolist (item items result) - (let ((id (citeproc-s-from-num-or-s (alist-get 'id item)))) - (when (member id itemids) - (push (cons id item) result))))))) - -(defun citeproc-test-human--proc-from-style (style parsed-input) - "Create a processor from STYLE and PARSED-INPUT." - (citeproc-create style - (citeproc-test-human--create-getter parsed-input) - (citeproc-locale-getter-from-dir citeproc-test-human--locale-dir))) - -(defun citeproc-test-human--proc-from-testfile (file) - "Create an (itemless) processor from a test FILE." - (let ((style-string (alist-get 'CSL (citeproc-test-human--parse-testfile file))) - (locale-getter (citeproc-locale-getter-from-dir citeproc-test-human--locale-dir))) - (citeproc-create style-string nil locale-getter))) - -(defun citeproc-test-human--parse-citation (ct-desc &optional cites-only) - "Parse test citations description CT-DESC. -Return a list of citation structures. If CITES-ONLY is non-nil -then the input is list of cites." - (if cites-only - (citeproc-citation-create - :cites (-map #'citeproc-test-human--normalize-cite ct-desc)) - (let ((citation-info (car ct-desc))) - (let-alist (alist-get 'properties citation-info) - (citeproc-citation-create - :cites (-map #'citeproc-test-human--normalize-cite - (alist-get 'citationItems citation-info)) - :note-index .noteIndex - :mode (citeproc-lib-intern .mode) - :capitalize-first .capitalize-first - :suppress-affixes .suppress-affixes - :ignore-et-al .ignore-et-al))))) - -(defun citeproc-test-human--normalize-cite (cite) - "Normalize a test CITE." - (--map (let ((val (cdr it))) - (if (numberp val) (cons (car it) (number-to-string val)) it)) - cite)) - -(defun citeproc-test-human--run-parsed (parsed) - "Run the parsed CSL test PARSED. -Return the resulting output." - (-let* (((&alist 'CSL style - 'INPUT input - 'MODE mode - 'CITATION-ITEMS citation-items - 'CITATIONS citations - 'OUTPUT-FORMAT output-format) - parsed) - (output-format (or output-format 'csl-test)) - (proc (citeproc-test-human--proc-from-style style input))) - (--each input - (citeproc-proc-put-item-by-id proc - (citeproc-s-from-num-or-s (alist-get 'id it)))) - (when (string= mode "citation") - (cond - (citation-items - (citeproc-append-citations (--map (citeproc-test-human--parse-citation it t) - citation-items) - proc)) - (citations - (citeproc-append-citations (mapcar #'citeproc-test-human--parse-citation citations) - proc)) - (t (citeproc-append-citations (list (citeproc-test-human--parse-citation input t)) - proc)))) - (let ((output (if (string= mode "citation") - (citeproc-render-citations proc output-format - (when (eq 'csl-test output-format) - 'no-links)) - (car (citeproc-render-bib proc output-format 'no-links))))) - (if (string= mode "citation") (s-join "\n" output) output)))) - -(defun citeproc-test-human--expected-from-parsed (parsed) - "Return the expected output of parsed CSL test PARSED." - (let ((expected (alist-get 'RESULT parsed))) - (if (or (string= (s-left 5 expected) "..[0]") - (string= (s-left 5 expected) ">>[0]")) - (s-join "\n" (--map (substring it 6) - (split-string expected "\n"))) - expected))) - -(defun citeproc-test-human-create-from-file (file expected-fails &optional name-prefix) - "Create an ERT test from a CSL test FILE. -If optional NAME-PREFIX is non-nil then it is added the name of -the created test after the obligatory `citeproc'." - (let* ((parsed (citeproc-test-human--parse-testfile file)) - (expected (citeproc-test-human--expected-from-parsed parsed)) - (file-name (f-filename file)) - (test-name (intern - (concat "citeproc-" - (if name-prefix (concat name-prefix "-") "") - (string-inflection-kebab-case-function - (substring file-name 0 -4))))) - (expected-fail (memq test-name expected-fails))) - (eval `(ert-deftest ,test-name () - :expected-result ,(if expected-fail :failed :passed) - (let ((citeproc-disambiguation-cite-pos 'subsequent)) - (should (string= - ,expected - (citeproc-test-human--run-parsed ',parsed)))))))) - -(defun citeproc-test-human---read-expected-fails (expected-fails-file) - "Read the list of tests expected to fail from EXPECTED-FAILS-FILE." - (let* ((list-as-str (with-temp-buffer - (insert-file-contents expected-fails-file) - (buffer-string))) - (split (split-string list-as-str "\n"))) - (--map (intern it) (butlast split)))) - -(defun citeproc-test-human-create-from-dir (dir &optional - expected-fails-file name-prefix) - "Create all CSL tests from DIR. -Each file in DIR having the `txt' extension is read as a -human-readable CSL test, and a corresponding ERT test is created. -The created test's name will be constructed by prefixing the -test's filename (without the extension) with `citeproc-'. If the -optional EXPECTED-FAILS-FILE is non-nil then read that file as a -list of tests whose failure is expected. If optional NAME-PREFIX -is non-nil then it is added the names of the created tests after -the obligatory `citeproc'. The file should contain one test-name -per line (together with the `citeproc-' prefix)." - (let ((expected-fails - (if expected-fails-file - (citeproc-test-human---read-expected-fails expected-fails-file) - nil))) - (dolist (test-file (f-glob (concat dir "/*.txt"))) - (citeproc-test-human-create-from-file test-file expected-fails - name-prefix)))) - -(provide 'citeproc-test-human) - -;;; citeproc-test-human.el ends here diff --git a/elpa/citeproc-20230228.1414/citeproc.el b/elpa/citeproc-20230228.1414/citeproc.el deleted file mode 100644 index 0a930bae..00000000 --- a/elpa/citeproc-20230228.1414/citeproc.el +++ /dev/null @@ -1,317 +0,0 @@ -;;; citeproc.el --- A CSL 1.0.2 Citation Processor -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2023 András Simonyi - -;; Author: András Simonyi -;; Maintainer: András Simonyi -;; URL: https://github.com/andras-simonyi/citeproc-el -;; Keywords: bib -;; Package-Requires: ((emacs "26") (dash "2.13.0") (s "1.12.0") (f "0.18.0") (queue "0.2") (string-inflection "1.0") (org "9") (parsebib "2.4")) -;; Version: 0.9.3 - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; citeproc-el is a library for rendering citations and bibliographies in styles -;; described in the Citation Style Language (CSL). - -;;; Code: - -(require 'dash) -(require 'queue) - -(require 'citeproc-rt) -(require 'citeproc-locale) -(require 'citeproc-style) -(require 'citeproc-choose) -(require 'citeproc-generic-elements) -(require 'citeproc-context) -(require 'citeproc-itemdata) -(require 'citeproc-proc) -(require 'citeproc-cite) -(require 'citeproc-sort) -(require 'citeproc-formatters) -(require 'citeproc-itemgetters) -(require 'citeproc-subbibs) - -;;; Public API - -(defun citeproc-create (style it-getter loc-getter &optional loc force-loc) - "Return a CSL processor for a given STYLE, IT-GETTER and LOC-GETTER. -STYLE is either a path to a CSL style file or a CSL style as a - string. -IT-GETTER is an item-getter function that takes a list of itemid - strings as its sole argument and returns an alist in which the - given itemids are the keys and the values are the parsed csl - json descriptions of the corresponding bibliography items (keys - are symbols, arrays and hashes should be represented as lists - and alists, respecively). -LOC-GETTER is a function that takes a locale string (e.g. - \"en-GB\") as an argument and returns a corresponding parsed - CSL locale (as parsed by Emacs's `libxml-parse-xml-region'). -Optional LOC is the locale to use if the style doesn't specify a - default one. Defaults to \"en-US\". -If optional FORCE-LOC is non-nil then use locale LOC even if - STYLE specifies a different one as default. Defaults to nil." - (let ((style (citeproc-create-style style loc-getter loc force-loc)) - (names (make-hash-table :test 'equal)) - (itemdata (make-hash-table :test 'equal)) - (citations (make-queue))) - (citeproc-proc--create :style style :getter it-getter :names names - :itemdata itemdata :citations citations :finalized t))) - -(defun citeproc-append-citations (citations proc) - "Append CITATIONS to the list of citations in PROC. -CITATIONS is a list of `citeproc-citation' structures." - (let ((itemdata (citeproc-proc-itemdata proc)) - ids) - ;; Collect new itemids - (dolist (citation citations) - (dolist (cite (citeproc-citation-cites citation)) - (push (alist-get 'id cite) ids))) - (let* ((uniq-ids (delete-dups (nreverse ids))) ; reverse pushed ids - (new-ids (--remove (gethash it itemdata) uniq-ids))) - ;; Add all new items in one pass - (citeproc-proc-put-items-by-id proc new-ids) - ;; Add itemdata to the cite structs and add them to the cite queue. - (dolist (citation citations) - (setf (citeproc-citation-cites citation) - (--map (cons (cons 'itd (gethash (alist-get 'id it) itemdata)) it) - (citeproc-citation-cites citation))) - (queue-append (citeproc-proc-citations proc) citation)) - (setf (citeproc-proc-finalized proc) nil)))) - -(defun citeproc-add-uncited (itemids proc) - "Add uncited bib items with ITEMIDS to PROC. -As an extension, an itemid can be the string \"*\" which has the -effect of adding all items available in the itemgetter." - ;; We simply store the added ids here, real processing is performed when the - ;; processor is finalized. - (push itemids (citeproc-proc-uncited proc)) - (setf (citeproc-proc-finalized proc) nil)) - -(defun citeproc-add-subbib-filters (filters proc) - "Add sub-bibliography FILTERS to PROC. -FILTERS should be a list of alists containing symbol keys and -string values, each pair describing an atomic condition to be -satisified by the printed entries. The following keys are -supported: -- `type': print only entries of the given type. Type is the - bib(la)tex entry type if available, otherwise the CSL type is - used as fallback; -- `nottype': print only entries not of the given type. Type is - the bib(la)tex entry type if available, otherwise the CSL type - is used as fallback; -- `csltype', `notcsltype': same as `type' and `nottype' but uses - the entries' CSL type even if the bib(la)tex type is also - available; -- `keyword': print only entries with the given keyword; -- `notkeyword': print only entries without the given keyword; -- `filter': print only entries for which the function named by - the key returns a non-nil value." - (setf (citeproc-proc-bib-filters proc) filters - (citeproc-proc-finalized proc) nil)) - -(defun citeproc-render-citations (proc format &optional internal-links) - "Render all citations in PROC in the given FORMAT. -Return a list of formatted citations. - If the optional INTERNAL-LINKS is `bib-links' then link cites -to the bibliography regardless of the style type, if `no-links' -then don't add internal links, if nil or `auto' then add internal -links based on the style type (cite-cite links for note styles -and cite-bib links else). For legacy reasons, any other value is -treated as `no-links'." - (citeproc-proc-finalize proc) - (--map (citeproc-citation--render-formatted-citation it proc format internal-links) - (queue-head (citeproc-proc-citations proc)))) - -(defun citeproc-render-bib (proc format &optional internal-links - no-external-links bib-formatter-fun) - "Render a bibliography of items in PROC in FORMAT. -For the optional INTERNAL-LINKS argument see -`citeproc-render-citations'. If the optional NO-EXTERNAL-LINKS is -non-nil then don't generate external links. If the optional -BIB-FORMATTER-FUN is given then it will be used to join the -bibliography items instead of the content of the chosen -formatter's `bib' slot (see `citeproc-formatter' for details). - -Returns an error message string if the style of PROC doesn't -contain a bibliography section. Otherwise it returns -a (FORMATTED-BIBLIOGRAPHY . FORMATTING-PARAMETERS) cons cell, -where FORMATTED-BIBLIOGRAPHY is either a single bibliography or a -list of sub-bibliograhies if filters were added to the processor, -and FORMATTING-PARAMETERS is an alist containing the following -formatting parameters keyed to the parameter names as symbols: -- `max-offset' (integer): The width of the widest first field in - the bibliography, measured in characters. -- `line-spacing' (integer): Vertical line distance specified as a - multiple of standard line height. -- `entry-spacing' (integer): Vertical distance between - bibliographic entries, specified as a multiple of standard line - height. -- `second-field-align' (`flush'or `margin'): The position of - second-field alignment. -- `hanging-indent' (boolean): Whether the bibliography items should - be rendered with hanging-indents." - (if (null (citeproc-style-bib-layout (citeproc-proc-style proc))) - "[NO BIBLIOGRAPHY LAYOUT IN CSL STYLE]" - (citeproc-proc-finalize proc) - (let* ((formatter (citeproc-formatter-for-format format)) - (rt-formatter (citeproc-formatter-rt formatter)) - (bib-formatter (or bib-formatter-fun - (citeproc-formatter-bib formatter))) - (bibitem-formatter (citeproc-formatter-bib-item formatter)) - (formatter-no-external-links (citeproc-formatter-no-external-links - formatter)) - (style (citeproc-proc-style proc)) - (bib-opts (citeproc-style-bib-opts style)) - (punct-in-quote (string= (alist-get 'punctuation-in-quote - (citeproc-style-locale-opts style)) - "true")) - (itemdata (citeproc-proc-itemdata proc)) - (filters (citeproc-proc-bib-filters proc))) - ;; Render raw bibitems for each itemdata struct and store them in the - ;; `rawbibitem' slot. - (maphash (lambda (_ itd) - (setf (citeproc-itemdata-rawbibitem itd) - (citeproc-rt-finalize - (citeproc-render-varlist-in-rt - (citeproc-itemdata-varvals itd) - style 'bib 'display internal-links - (or formatter-no-external-links no-external-links)) - punct-in-quote))) - itemdata) - (let* ((raw-bib - (if (citeproc-proc-filtered-bib-p proc) - ;; There are filters, we need to select and sort the subbibs. - (let* ((nr-of-filters (length filters)) - (result (make-list nr-of-filters nil)) - ;; We store boolean to-be-sorted flags for each sub-bib - (to-be-sorted (make-bool-vector nr-of-filters nil)) - (bib-sort (citeproc-style-bib-sort (citeproc-proc-style proc)))) - ;; Put the itds into subbib lists. - (maphash - (lambda (_ itd) - (let ((subbib-nos (citeproc-itemdata-subbib-nos itd))) - ;; Set to-be-sorted for later subbibs if itemdata - ;; occcurs in more than one. - (when-let ((later-subbib-nos (cdr subbib-nos))) - (dolist (subbib-no later-subbib-nos) - (setf (elt to-be-sorted subbib-no) t))) - ;; Push the item in all corresponding subbibs. - (dolist (subbib-no subbib-nos) - (push itd (elt result subbib-no))))) - itemdata) - ;; Sort the itds in each individual list - (setq result - (--map-indexed - (if (and bib-sort (elt to-be-sorted it-index)) - ;; Subbib contains earlier item, needs to sorted. - (citeproc-sort-itds it (citeproc-style-bib-sort-orders - (citeproc-proc-style proc))) - ;; No earlier item, sorting on citation-number. - (citeproc-sort-itds-on-citnum it)) - result)) - ;; Generate the raw bibs. - (--map (mapcar #'citeproc-itemdata-rawbibitem it) result)) - ;; No filters, so raw-bib is a list containing a single raw bibliograhy. - (list (mapcar #'citeproc-itemdata-rawbibitem - (citeproc-sort-itds-on-citnum (hash-table-values itemdata)))))) - ;; Perform author-substitution. - (substituted - (-if-let (subs-auth-subst - (alist-get 'subsequent-author-substitute bib-opts)) - (--map (citeproc-rt-subsequent-author-substitute it subs-auth-subst) - raw-bib) - raw-bib)) - ;; Calculate formatting params. - (max-offset (if (alist-get 'second-field-align bib-opts) - (citeproc-rt-max-offset itemdata) - 0)) - (format-params (cons (cons 'max-offset max-offset) - (citeproc-style-bib-opts-to-formatting-params bib-opts))) - (formatted-bib - (--map (funcall bib-formatter - (mapcar - (lambda (x) - (funcall - bibitem-formatter - (funcall - rt-formatter (citeproc-rt-cull-spaces-puncts x)) - format-params)) - it) - format-params) - substituted))) - ;; Generate final return value. - (cons (if filters formatted-bib (car formatted-bib)) - format-params))))) - -(defun citeproc-clear (proc) - "Remove all bibliographic and citation data from PROC." - (clrhash (citeproc-proc-itemdata proc)) - (clrhash (citeproc-proc-names proc)) - (queue-clear (citeproc-proc-citations proc)) - (setf (citeproc-proc-finalized proc) t)) - -;; For one-off renderings - -(defun citeproc-create-style (style locale-getter &optional locale force-locale) - "Compile style in STYLE into a citeproc-style struct. -STYLE is either a path to a CSL style file, or a style as a -string. LOCALE-GETTER is a getter function for locales, the -optional LOCALE is a locale to prefer. If FORCE-LOCALE is non-nil -then use LOCALE even if the style's default locale is different." - (-let* (((year-suffix . parsed-style) (citeproc-style-parse style)) - (default-locale (alist-get 'default-locale (cadr parsed-style))) - (preferred-locale (if force-locale locale (or default-locale - locale - "en-US"))) - (act-parsed-locale (funcall locale-getter preferred-locale)) - (act-locale (alist-get 'lang (cadr act-parsed-locale))) - (style (citeproc-create-style-from-locale - parsed-style - (not (not year-suffix)) act-locale))) - (citeproc-style--update-locale style act-parsed-locale) - (citeproc-style--set-opt-defaults style) - (setf (citeproc-style-locale style) (or locale act-locale)) - style)) - -;; REVIEW: this should be rethought -- should we apply the specific wrappers as -;; well? -(defun citeproc-render-item (item-data style mode format - &optional no-external-links) - "Render a bibliography item described by ITEM-DATA with STYLE. -ITEM-DATA is the parsed form of a bibliography item description - in CSL-JSON format, -STYLE is a `citeproc-style' structure, -MODE is one of the symbols `bib' or `cite', -FORMAT is a symbol representing a supported output format. -If the optional NO-EXTERNAL-LINKS is non-nil then don't generate -external links in the item." - (let ((internal-varlist (--map-when (memq (car it) citeproc--date-vars) - (cons (car it) - (citeproc-date-parse (cdr it))) - item-data))) - (funcall (citeproc-formatter-rt (citeproc-formatter-for-format format)) - (citeproc-rt-cull-spaces-puncts - (citeproc-rt-finalize - (citeproc-render-varlist-in-rt - internal-varlist style mode 'display 'no-links no-external-links)))))) - -(provide 'citeproc) - -;;; citeproc.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-autoloads.el b/elpa/citeproc-20240722.1110/citeproc-autoloads.el new file mode 100644 index 00000000..6a99cb54 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-autoloads.el @@ -0,0 +1,153 @@ +;;; citeproc-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from citeproc.el + +(register-definition-prefixes "citeproc" '("citeproc-")) + + +;;; Generated autoloads from citeproc-biblatex.el + +(register-definition-prefixes "citeproc-biblatex" '("citeproc-blt-")) + + +;;; Generated autoloads from citeproc-bibtex.el + +(register-definition-prefixes "citeproc-bibtex" '("citeproc-bt-")) + + +;;; Generated autoloads from citeproc-choose.el + +(register-definition-prefixes "citeproc-choose" '("citeproc-")) + + +;;; Generated autoloads from citeproc-cite.el + +(register-definition-prefixes "citeproc-cite" '("citeproc-")) + + +;;; Generated autoloads from citeproc-context.el + +(register-definition-prefixes "citeproc-context" '("citeproc-")) + + +;;; Generated autoloads from citeproc-date.el + +(register-definition-prefixes "citeproc-date" '("citeproc-")) + + +;;; Generated autoloads from citeproc-disamb.el + +(register-definition-prefixes "citeproc-disamb" '("citeproc-")) + + +;;; Generated autoloads from citeproc-formatters.el + +(register-definition-prefixes "citeproc-formatters" '("citeproc-f")) + + +;;; Generated autoloads from citeproc-generic-elements.el + +(register-definition-prefixes "citeproc-generic-elements" '("citeproc-")) + + +;;; Generated autoloads from citeproc-itemdata.el + +(register-definition-prefixes "citeproc-itemdata" '("citeproc-itd-")) + + +;;; Generated autoloads from citeproc-itemgetters.el + +(register-definition-prefixes "citeproc-itemgetters" '("citeproc-")) + + +;;; Generated autoloads from citeproc-lib.el + +(register-definition-prefixes "citeproc-lib" '("citeproc-")) + + +;;; Generated autoloads from citeproc-locale.el + +(register-definition-prefixes "citeproc-locale" '("citeproc-locale-")) + + +;;; Generated autoloads from citeproc-macro.el + +(register-definition-prefixes "citeproc-macro" '("citeproc-")) + + +;;; Generated autoloads from citeproc-name.el + +(register-definition-prefixes "citeproc-name" '("citeproc-")) + + +;;; Generated autoloads from citeproc-number.el + +(register-definition-prefixes "citeproc-number" '("citeproc-")) + + +;;; Generated autoloads from citeproc-prange.el + +(register-definition-prefixes "citeproc-prange" '("citeproc-prange-")) + + +;;; Generated autoloads from citeproc-proc.el + +(register-definition-prefixes "citeproc-proc" '("citeproc-proc-")) + + +;;; Generated autoloads from citeproc-rt.el + +(register-definition-prefixes "citeproc-rt" '("citeproc-rt-")) + + +;;; Generated autoloads from citeproc-s.el + +(register-definition-prefixes "citeproc-s" '("citeproc-s-")) + + +;;; Generated autoloads from citeproc-sort.el + +(register-definition-prefixes "citeproc-sort" '("citeproc-")) + + +;;; Generated autoloads from citeproc-style.el + +(register-definition-prefixes "citeproc-style" '("citeproc-")) + + +;;; Generated autoloads from citeproc-subbibs.el + +(register-definition-prefixes "citeproc-subbibs" '("citeproc-sb-")) + + +;;; Generated autoloads from citeproc-term.el + +(register-definition-prefixes "citeproc-term" '("citeproc-term-")) + + +;;; Generated autoloads from citeproc-test-human.el + +(register-definition-prefixes "citeproc-test-human" '("citeproc-test-human-")) + +;;; End of scraped data + +(provide 'citeproc-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; citeproc-autoloads.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-biblatex.el b/elpa/citeproc-20240722.1110/citeproc-biblatex.el new file mode 100644 index 00000000..0cb218d3 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-biblatex.el @@ -0,0 +1,523 @@ +;;; citeproc-biblatex.el --- convert biblatex entries to CSL -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Convert biblatex bibliography entries to CSL. + +;;; Code: + +(require 'parse-time) +(require 'compat) + +(require 'citeproc-bibtex) + +(defvar citeproc-blt-to-csl-types-alist + '((article . "article-journal") + (book . "book") + (periodical . "book") + (booklet . "pamphlet") + (bookinbook . "chapter") + (misc . "article") + (other . "article") + (standard . "legislation") + (collection . "book") + (conference . "paper-conference") + (dataset . "dataset") + (electronic . "webpage") + (inbook . "chapter") + (incollection . "chapter") + (inreference . "entry-encyclopedia") + (inproceedings . "paper-conference") + (manual . "book") + (mastersthesis . "thesis") + (mvbook . "book") + (mvcollection . "book") + (mvproceedings . "book") + (mvreference . "book") + (online . "webpage") + (patent . "patent") + (phdthesis . "thesis") + (proceedings . "book") + (reference . "book") + (report . "report") + (software . "software") + (suppbook . "chapter") + (suppcollection . "chapter") + (techreport . "report") + (thesis . "thesis") + (unpublished . "manuscript") + (www . "webpage") + (artwork . "graphic") + (audio . "song") + (commentary . "book") + (image . "figure") + (jurisdiction . "legal_case") + (legislation . "bill") ? + (legal . "treaty") + (letter . "personal_communication") + (movie . "motion_picture") + (music . "song") + (performance . "speech") + (review . "review") + (standard . "legislation") + (video . "motion_picture") + (data . "dataset") + (letters . "personal_communication") + (newsarticle . "article-newspaper")) + "Alist mapping biblatex item types to CSL item types.") + +(defun citeproc-blt--to-csl-type (type entrysubtype) + "Return the CSL type corresponding to blt TYPE and ENTRYSUBTYPE." + (pcase type + ((or 'article 'periodical 'supperiodical) + (pcase entrysubtype + ("magazine" "article-magazine") + ("newspaper" "article-newspaper") + (_ "article-journal"))) + (_ (assoc-default type citeproc-blt-to-csl-types-alist)))) + +(defvar citeproc-blt-reftype-to-genre + '(("mastersthesis" . "Master's thesis") + ("phdthesis" . "PhD thesis") + ("mathesis" . "Master's thesis") + ("resreport" . "research report") + ("techreport" . "technical report") + ("patreqfr" . "French patent request") + ("patenteu" . "European patent") + ("patentus" . "U.S. patent")) + "Alist mapping biblatex reftypes to CSL genres.") + +(defvar citeproc-blt-article-types + '(article periodical suppperiodical review) + "Article-like biblatex types.") + +(defvar citeproc-blt-chapter-types + '(inbook incollection inproceedings inreference bookinbook) + "Chapter-like biblatex types.") + +(defvar citeproc-blt-collection-types + '(book collection proceedings reference + mvbook mvcollection mvproceedings mvreference + bookinbook inbook incollection inproceedings + inreference suppbook suppcollection) + "Collection or collection part biblatex types.") + +(defvar citeproc-blt-to-csl-names-alist + '((author . author) + (editor . editor) + (bookauthor . container-author) + (translator . translator)) + "Alist mapping biblatex name fields to the corresponding CSL ones.") + +(defvar citeproc-blt-editortype-to-csl-name-alist + '(("organizer" . organizer) + ("director" . director) + ("compiler" . compiler) + ("editor" . editor) + ("collaborator" . contributor)) + "Alist mapping biblatex editortypes to CSL fields.") + +(defvar citeproc-blt-to-csl-dates-alist + '((eventdate . event-date) + (origdate . original-date) + (urldate . accessed)) + "Alist mapping biblatex date fields to the corresponding CSL ones.") + +(defconst citeproc-blt--publisher-fields + '(school institution organization howpublished publisher) + "Biblatex fields containing publisher-related information.") + +(defconst citeproc-blt--etype-to-baseurl-alist + '(("arxiv" . "https://arxiv.org/abs/") + ("jstor" . "https://www.jstor.org/stable/") + ("pubmed" ."https://www.ncbi.nlm.nih.gov/pubmed/") + ("googlebooks" . "https://books.google.com?id=")) + "Alist mapping biblatex date fields to the corresponding CSL ones.") + +(defvar citeproc-blt-to-csl-standard-alist + '(;; locators + (volume . volume) + (part . part) + (edition . edition) + (version . version) + (volumes . number-of-volumes) + (pagetotal . number-of-pages) + (chapter . chapter-number) + (pages . page) + ;; publisher + (origpublisher . original-publisher) + ;; places + (venue . event-place) + (origlocation . original-publisher-place) + (address . publisher-place) + ;; doi etcetera + (doi . DOI) + (isbn . ISBN) + (issn . ISSN) + (pmid . PMID) + (pmcid . PMCID) + (library . call-number) + ;; notes + (abstract . abstract) + (annotation . annote) + (annote . annote) ; alias for jurabib compatibility + ;; else + (pubstate . status) + (language . language) + (version . version) + (keywords . keyword) + (label . citation-label)) + "Alist mapping biblatex standard fields to the corresponding CSL ones. +Only those fields are mapped that do not require further processing.") + +(defvar citeproc-blt-to-csl-title-alist + '((eventtitle . event-title) + (origtitle . original-title) + (series . collection-title)) + "Alist mapping biblatex title fields to the corresponding CSL ones. +Only those fields are mapped that do not require further +processing.") + +(defun citeproc-blt--parse-date (d) + "Parse single biblatex date-time expression D." + ;; Remove time part, if present. + (-when-let (time-sep-pos (cl-position ?T d)) + (setq d (substring d 0 time-sep-pos))) + (--map (let ((converted (string-to-number it))) + (if (not (= converted 0)) + converted + (error "Couldn't parse '%s' as a date" d))) + (split-string d "-"))) + +(defun citeproc-blt--to-csl-date (d) + "Return a CSL version of the biblatex date field given by D." + (let* ((interval-strings (split-string d "/")) + (interval-date-parts + (mapcar #'citeproc-blt--parse-date interval-strings))) + (list (cons 'date-parts interval-date-parts)))) + +(defun citeproc-blt--get-standard (v b &optional with-nocase) + "Return the CSL-normalized value of var V from item B. +V is a biblatex var name as a string, B is a biblatex entry as an +alist. If optional WITH-NOCASE is non-nil then convert BibTeX +no-case brackets to the corresponding CSL XML spans. Return nil +if V is undefined in B." + (-when-let (blt-val (alist-get v b)) + (citeproc-bt--to-csl blt-val with-nocase))) + +(defun citeproc-blt--get-title (v b &optional with-nocase sent-case) + "Return the CSL-normalized value of a title var V from item B. +If optional WITH-NOCASE is non-nil then convert BibTeX no-case +brackets to the corresponding CSL XML spans, and if optional +SENT-CASE is non-nil the convert to sentence-case. Return nil if +V is undefined in B." + (-when-let (blt-val (alist-get v b)) + (citeproc-blt--to-csl-title blt-val with-nocase sent-case))) + +(defun citeproc-blt--to-csl-title (s with-nocase sent-case) + "Return the CSL-normalized value of a title string S. +If optional WITH-NOCASE is non-nil then convert BibTeX no-case +brackets to the corresponding CSL XML spans, and if optional +SENT-CASE is non-nil the convert to sentence-case." + (if sent-case + (citeproc-s-sentence-case-title (citeproc-bt--to-csl s t) (not with-nocase)) + (citeproc-bt--to-csl s with-nocase))) + +(defconst citeproc-blt--titlecase-langids + '("american" "british" "canadian" "english" "australian" "newzealand" + "USenglish" "UKenglish") + "List of biblatex langids with title-cased title fields.") + +(defconst citeproc-blt--langid-to-lang-alist + '(("english" . "en-US") + ("USenglish" . "en-US") + ("american" . "en-US") + ("british" . "en-GB") + ("UKenglish" . "en-GB") + ("canadian" . "en-US") + ("australian" . "en-GB") + ("newzealand" . "en-GB") + ("afrikaans" . "af-ZA") + ("arabic" . "ar") + ("basque" . "eu") + ("bulgarian" . "bg-BG") + ("catalan" . "ca-AD") + ("croatian" . "hr-HR") + ("czech" . "cs-CZ") + ("danish" . "da-DK") + ("dutch" . "nl-NL") + ("estonian" . "et-EE") + ("finnish" . "fi-FI") + ("canadien" . "fr-CA") + ("acadian" . "fr-CA") + ("french" . "fr-FR") + ("francais" . "fr-FR") + ("austrian" . "de-AT") + ("naustrian" . "de-AT") + ("german" . "de-DE") + ("germanb" . "de-DE") + ("ngerman" . "de-DE") + ("greek" . "el-GR") + ("polutonikogreek" . "el-GR") + ("hebrew" . "he-IL") + ("hungarian" . "hu-HU") + ("icelandic" . "is-IS") + ("italian" . "it-IT") + ("japanese" . "ja-JP") + ("latvian" . "lv-LV") + ("lithuanian" . "lt-LT") + ("magyar" . "hu-HU") + ("mongolian" . "mn-MN") + ("norsk" . "nb-NO") + ("nynorsk" . "nn-NO") + ("farsi" . "fa-IR") + ("polish" . "pl-PL") + ("brazil" . "pt-BR") + ("brazilian" . "pt-BR") + ("portugues" . "pt-PT") + ("portuguese" . "pt-PT") + ("romanian" . "ro-RO") + ("russian" . "ru-RU") + ("serbian" . "sr-RS") + ("serbianc" . "sr-RS") + ("slovak" . "sk-SK") + ("slovene" . "sl-SL") + ("spanish" . "es-ES") + ("swedish" . "sv-SE") + ("thai" . "th-TH") + ("turkish" . "tr-TR") + ("ukrainian" . "uk-UA") + ("vietnamese" . "vi-VN") + ("latin" . "la")) + "Alist mapping biblatex langids to CSL language codes.") + +(defun citeproc-blt-entry-to-csl (b &optional omit-nocase no-sentcase-wo-langid) + "Return a CSL form of parsed biblatex entry B. +If the optional OMIT-NOCASE is non-nil then no no-case XML +markers are generated, and if the optional NO-SENTCASE-WO-LANGID +is non-nil then title fields in items without a `langid' field +are not converted to sentence-case. + +The processing logic follows the analogous +function (itemToReference) in John MacFarlane's Pandoc, see + +Many thanks to him. + +Note: in the code, var names starting with ~ refer to values of +biblatex variables in B." + (let* ((b (cl-remove-if (lambda (x) (equal "" (cdr x))) b)) + (b (mapcar (lambda (x) (cons (intern (downcase (car x))) (cdr x))) b)) + (~type (intern (downcase (alist-get '=type= b)))) + (~entrysubtype (alist-get 'entrysubtype b)) + (type (citeproc-blt--to-csl-type ~type ~entrysubtype)) + (is-article (memq ~type citeproc-blt-article-types)) + (is-periodical (eq ~type 'periodical)) + (is-chapter-like (memq ~type citeproc-blt-chapter-types)) + (~langid (alist-get 'langid b)) + (sent-case (or (member ~langid citeproc-blt--titlecase-langids) + (and (null ~langid) (not no-sentcase-wo-langid)))) + (with-nocase (not omit-nocase)) + result) + ;; language + (when ~langid + (push (cons 'language (cdr (assoc ~langid citeproc-blt--langid-to-lang-alist))) + result)) + ;; set type and genre + (push (cons 'type type) result) + (when-let ((~reftype (alist-get 'type b))) + (push (cons 'genre (or (assoc-default ~reftype citeproc-blt-reftype-to-genre) + (citeproc-bt--to-csl ~reftype))) + result)) + ;; We store the original bib(la)tex type for filtering purposes. + (push (cons 'blt-type (symbol-name ~type)) result) + ;; names + ;; TODO: handle editorb and editorc as well... + (when-let ((~editortype (alist-get 'editortype b)) + (~editor (alist-get 'editor b)) + (csl-var (assoc-default ~editortype + citeproc-blt-editortype-to-csl-name-alist))) + (push (cons csl-var (citeproc-bt--to-csl-names ~editor)) + result)) + (when-let ((~editoratype (alist-get 'editoratype b)) + (~editora (alist-get 'editora b)) + (csl-var (assoc-default ~editoratype + citeproc-blt-editortype-to-csl-name-alist))) + (push (cons csl-var (citeproc-bt--to-csl-names ~editora)) + result)) + ;; dates + (-when-let (issued (-if-let (~issued (alist-get 'date b)) + (citeproc-blt--to-csl-date ~issued) + (-when-let (~year (alist-get 'year b)) + (citeproc-bt--to-csl-date ~year + (alist-get 'month b))))) + (push (cons 'issued issued) result)) + ;; locators + (-if-let (~number (alist-get 'number b)) + (cond ((memq ~type citeproc-blt-collection-types) ; collection + (push `(collection-number . ,~number) result)) + (is-article ; article + (push `(issue . ,(-if-let (~issue (alist-get 'issue b)) + (concat ~number ", " ~issue) + ~number)) + result)) + (t (push `(number . ,~number) result)))) + ;; titles + (let* ((~maintitle (citeproc-blt--get-title 'maintitle b with-nocase sent-case)) + (title + (cond (is-periodical (citeproc-blt--get-title 'issuetitle b with-nocase sent-case)) + ((and ~maintitle (not is-chapter-like)) ~maintitle) + (t (citeproc-blt--get-title 'title b with-nocase sent-case)))) + (subtitle (citeproc-blt--get-title + (cond (is-periodical 'issuesubtitle) + ((and ~maintitle (not is-chapter-like)) + 'mainsubtitle) + (t 'subtitle)) + b with-nocase sent-case)) + (title-addon + (citeproc-blt--get-title + (if (and ~maintitle (not is-chapter-like)) + 'maintitleaddon 'titleaddon) + b with-nocase sent-case)) + (volume-title + (when ~maintitle + (citeproc-blt--get-title + (if is-chapter-like 'booktitle 'title) b with-nocase sent-case))) + (volume-subtitle + (when ~maintitle + (citeproc-blt--get-title + (if is-chapter-like 'booksubtitle 'subtitle) b with-nocase sent-case))) + (volume-title-addon + (when ~maintitle + (citeproc-blt--get-title + (if is-chapter-like 'booktitleaddon 'titleaddon) b with-nocase sent-case))) + (container-title + (or (and is-periodical (citeproc-blt--get-title 'title b with-nocase sent-case)) + (and is-chapter-like ~maintitle) + (and is-chapter-like (citeproc-blt--get-title + 'booktitle b with-nocase sent-case)) + (or (citeproc-blt--get-title 'journaltitle b with-nocase sent-case) + ;; also accept `journal' for BibTeX compatibility + (citeproc-blt--get-title 'journal b with-nocase sent-case)))) + (container-subtitle + (or (and is-periodical (citeproc-blt--get-title + 'subtitle b with-nocase sent-case)) + (and is-chapter-like (citeproc-blt--get-title + 'mainsubtitle b with-nocase sent-case)) + (and is-chapter-like (citeproc-blt--get-title + 'booksubtitle b with-nocase sent-case)) + (citeproc-blt--get-title 'journalsubtitle b with-nocase sent-case))) + (container-title-addon + (or (and is-periodical (citeproc-blt--get-title + 'titleaddon b with-nocase sent-case)) + (and is-chapter-like (citeproc-blt--get-title + 'maintitleaddon b with-nocase sent-case)) + (and is-chapter-like + (citeproc-blt--get-title 'booktitleaddon b with-nocase sent-case)))) + (container-title-short + (or (and is-periodical (not ~maintitle) + (citeproc-blt--get-title 'titleaddon b with-nocase sent-case)) + (citeproc-blt--get-title 'shortjournal b with-nocase sent-case))) + (title-short + (or (and (or (not ~maintitle) is-chapter-like) + (citeproc-blt--get-title 'shorttitle b with-nocase sent-case)) + (and (or subtitle title-addon) + (not ~maintitle) + title)))) + (when title + (push (cons 'title + (concat title + (when subtitle (concat ": " subtitle)) + (when title-addon (concat ". " title-addon)))) + result)) + (when title-short + (push (cons 'title-short title-short) result)) + (when volume-title + (push (cons 'volume-title + (concat volume-title + (when volume-subtitle (concat ": " volume-subtitle)) + (when volume-title-addon (concat ". " volume-title-addon)))) + result)) + (when container-title + (push (cons 'container-title + (concat container-title + (when container-subtitle (concat ": " container-subtitle)) + (when container-title-addon (concat ". " container-title-addon)))) + result)) + (when container-title-short + (push (cons 'container-title-short container-title-short) result))) + ;; publisher + (-when-let (values (-non-nil (--map (citeproc-blt--get-standard it b) + citeproc-blt--publisher-fields))) + (push `(publisher . ,(mapconcat #'identity values "; ")) result)) + ;; places + (let ((csl-place-var + (if (eq ~type 'patent) 'jurisdiction 'publisher-place))) + (-when-let (~location (or (citeproc-blt--get-standard 'location b) + (citeproc-blt--get-standard 'address b))) + (push (cons csl-place-var ~location) result))) + ;; url + (-when-let (url (or (let ((u (alist-get 'url b))) (and u (string-replace "\\" "" u))) + (when-let ((~eprinttype (or (alist-get 'eprinttype b) + (alist-get 'archiveprefix b))) + (~eprint (alist-get 'eprint b)) + (base-url + (assoc-default ~eprinttype + citeproc-blt--etype-to-baseurl-alist))) + (concat base-url ~eprint)))) + (push (cons 'URL url) result)) + ;; notes + (-when-let (note (let ((~note (citeproc-blt--get-standard 'note b)) + (~addendum (citeproc-blt--get-standard 'addendum b))) + (cond ((and ~note ~addendum) (concat ~note ". " ~addendum)) + (~note ~note) + (~addendum ~addendum) + (t nil)))) + (push (cons 'note note) result)) + ;; rest + (let (rest) + (pcase-dolist (`(,blt-key . ,blt-value) b) + ;; remaining standard vars + (-when-let (csl-key + (alist-get blt-key citeproc-blt-to-csl-standard-alist)) + (unless (alist-get csl-key result) + (push (cons csl-key (citeproc-bt--to-csl blt-value)) rest))) + ;; remaining name vars + (-when-let (csl-key + (alist-get blt-key citeproc-blt-to-csl-names-alist)) + (unless (alist-get csl-key result) + (push (cons csl-key (citeproc-bt--to-csl-names blt-value)) rest))) + ;; remaining date vars + (-when-let (csl-key + (alist-get blt-key citeproc-blt-to-csl-dates-alist)) + (unless (alist-get csl-key result) + (push (cons csl-key (citeproc-blt--to-csl-date blt-value)) rest))) + ;; remaining title vars + (-when-let (csl-key + (alist-get blt-key citeproc-blt-to-csl-title-alist)) + (push (cons csl-key + (citeproc-blt--to-csl-title blt-value with-nocase sent-case)) + rest))) + (append result rest)))) + +(provide 'citeproc-biblatex) + +;;; citeproc-biblatex.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-bibtex.el b/elpa/citeproc-20240722.1110/citeproc-bibtex.el new file mode 100644 index 00000000..aeb17d9a --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-bibtex.el @@ -0,0 +1,488 @@ +;;; citeproc-bibtex.el --- convert BibTeX entries to CSL -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Convert BibTeX bibliography entries to CSL. + +;;; Code: + +(require 'dash) +(require 'subr-x) +(require 'bibtex) +(require 'cl-lib) +(require 's) +(require 'org) +(require 'map) +(require 'compat) +;; Handle the fact that org-bibtex has been renamed to ol-bibtex -- for the time +;; being we support both feature names. +(or (require 'ol-bibtex nil t) + (require 'org-bibtex)) + +(require 'citeproc-s) + +;; Declare used ol-bibtex variables and functions to silence 'reference to free +;; variable' and 'function is not known to be defined' warnings during +;; compilation. +(defvar org-bibtex-key-property) +(defvar org-bibtex-type-property-name) +(defvar org-bibtex-export-arbitrary-fields) +(defvar org-bibtex-prefix) +(defvar org-bibtex-types) +(declare-function org-bibtex-get "ext:ol-bibtex") + +(defconst citeproc-bt--to-csl-types-alist + '(("article" . "article-journal") ("book" . "book") ("proceedings" . "book") + ("manual" . "book") ("periodical" . "book") ("booklet" . "pamphlet") + ("inbook" . "chapter") ("incollection" . "chapter") ("inproceedings" . "paper-conference") + ("conference" . "paper-conference") ("mastersthesis" . "thesis") ("phdthesis" . "thesis") + ("techreport" . "report") ("patent" . "patent") ("electronic" . "webpage") + ("misc" . "article") ("other" . "article") ("standard" . "legislation") + ("unpublished" . "manuscript") ("online" . "article-journal")) + "Alist mapping BibTeX item types to CSL item types.") + +(defconst citeproc-bt--to-csl-keys-alist + '(("=key=" . citation-label) ("address" . publisher-place) + ("booktitle" . container-title) ("journal" . container-title) + ("chapter" . title) ("location" . event-place) ("series" . collection-title) + ("keywords" . keyword) ("institution" . publisher) ("school" . publisher) + ("pages" . page) ("organization" . publisher) ("url" . URL) + ("doi" . DOI) ("pmid" . PMID) ("pmcid" . PMCID)) + "Alist mapping BibTeX keys to CSL keys with different names.") + +(defconst citeproc-bt--mon-to-num-alist + '(("jan" . 1) ("feb" . 2) ("mar" . 3) ("apr" . 4) ("may" . 5) ("jun" . 6) + ("jul" . 7) ("aug" . 8) ("sep" . 9) ("oct" . 10) ("nov" . 11) ("dec" . 12)) + "Alist mapping LaTeX abbreviated month names to ordinals.") + +(defconst citeproc-bt--pref-to-ucs-alist + '(("'" . "ACUTE") ("`" . "GRAVE") ("^" . "CIRCUMFLEX") ("~" . "TILDE") + ("=" . "MACRON") ("." . "WITH DOT ABOVE") ("\"" . "DIAERESIS") + ("''" . "DIAERESIS") ("H" . "DOUBLE ACUTE") ("r" . "WITH RING ABOVE") + ("u" . "BREVE") ("c" . "CEDILLA") ("k" . "OGONEK") ("v" . "CARON")) + "Alist mapping LaTeX prefixes to unicode name endings.") + +(defconst citeproc-bt--comm-letter-to-ucs-alist + '((("`" . "A") . "À") + (("'" . "A") . "Á") + (("^" . "A") . "Â") + (("~" . "A") . "Ã") + (("\"" . "A") . "Ä") + (("r" . "A") . "Å") + (("c" . "C") . "Ç") + (("v" . "C") . "Č") + (("'" . "C") . "Ć") + (("`" . "E") . "È") + (("'" . "E") . "É") + (("^" . "E") . "Ê") + (("\"" . "E") . "Ë") + (("`" . "I") . "Ì") + (("'" . "I") . "Í") + (("^" . "I") . "Î") + (("\"" . "I") . "Ï") + (("~" . "N") . "Ñ") + (("`" . "O") . "Ò") + (("'" . "O") . "Ó") + (("^" . "O") . "Ô") + (("~" . "O") . "Õ") + (("\"" . "O") . "Ö") + (("c" . "S") . "Ş") + (("v" . "S") . "Š") + (("`" . "U") . "Ù") + (("'" . "U") . "Ú") + (("^" . "U") . "Û") + (("\"" . "U") . "Ü") + (("'" . "Y") . "Ý") + (("`" . "a") . "à") + (("'" . "a") . "á") + (("^" . "a") . "â") + (("~" . "a") . "ã") + (("\"" . "a") . "ä") + (("r" . "a") . "å") + (("c" . "c") . "ç") + (("v" . "c") . "č") + (("'" . "c") . "ć") + (("`" . "e") . "è") + (("'" . "e") . "é") + (("^" . "e") . "ê") + (("\"" . "e") . "ë") + (("`" . "i") . "ì") + (("'" . "i") . "í") + (("^" . "i") . "î") + (("\"" . "i") . "ï") + (("~" . "n") . "ñ") + (("`" . "o") . "ò") + (("'" . "o") . "ó") + (("^" . "o") . "ô") + (("~" . "o") . "õ") + (("\"" . "o") . "ö") + (("v" . "r") . "ř") + (("c" . "s") . "ş") + (("v" . "s") . "š") + (("`" . "u") . "ù") + (("'" . "u") . "ú") + (("^" . "u") . "û") + (("\"" . "u") . "ü") + (("'" . "y") . "ý") + (("\"" . "y") . "ÿ") + (("H" . "o") . "ő") + (("H" . "O") . "Ő") + (("H" . "u") . "ű") + (("H" . "U") . "Ű") + (("v" . "z") . "ž") + (("v" . "Z") . "Ž")) + "Alist mapping LaTeX (SYMBOL-COMMAND . ASCII-CHAR) pairs to unicode characters.") + +(defconst citeproc-bt--to-ucs-alist + '(("l" . "ł") ("L" . "Ł") ("o" . "ø") ("O" . "Ø") ("AA" . "Å") ("aa" . "å") + ("AE" . "Æ") ("ae" . "æ") ("ss" . "ß") ("i" . "ı")) + "Alist mapping LaTeX commands to characters.") + +(defun citeproc-bt--to-ucs (ltx char) + "Return the unicode version of LaTeX command LTX applied to CHAR. +LTX is a one-char LaTeX accenting command (e.g. \"'\"), CHAR is +an ascii character. Return nil if no corresponding unicode +character was found." + (or (assoc-default (cons ltx char) citeproc-bt--comm-letter-to-ucs-alist) + ;; If the combination is not in citeproc-bt--comm-letter-to-ucs-alist + ;; then, as a last resort, we try to assemble the canonical unicode name + ;; of the requested character and look it up in (usc-names). This process + ;; can be *very slow* on older Emacs versions in which (usc-names) returns + ;; an alist! + + ;; NOTE: Because of a nasty interaction bug between `ucs-names' and + ;; `replace-regexp-in-string' we do the lookup only for Emacs versions + ;; earlier than 28. + (when-let* (((version< emacs-version "28" )) + (case-name (if (s-lowercase-p char) "SMALL" "CAPITAL")) + (combining-name (assoc-default ltx citeproc-bt--pref-to-ucs-alist)) + (name (concat "LATIN " case-name " LETTER " + (upcase char) " " combining-name)) + (char-name (map-elt (ucs-names) name))) + (char-to-string char-name)))) + +(defconst citeproc-bt--decode-rx + (rx (or + (seq "{\\" (group-n 1 (in "'" "`" "^" "~" "=" "." "\"")) (0+ space) + (group-n 2 letter) "}") + (seq "{\\" (group-n 1 (in "H" "r" "u" "c" "k" "v")) (1+ space) + (group-n 2 letter) "}") + (seq "{\\" (group-n 1 (or "l" "L" "o" "O" "AA" "aa" "ae" "AE" "ss" "i")) + (0+ space) "}") + (seq "\\" (group-n 1 (in "'" "`" "^" "~" "=" "." "\"" "H" "r" "u" "c" "k" "v")) + (0+ space) "{" (group-n 2 letter) "}") + (seq "\\" (group-n 1 (in "H" "r" "u" "c" "k" "v")) (1+ space) + (group-n 2 letter)) + (seq "\\" (group-n 1 (in "'" "`" "^" "~" "=" "." "\"")) (0+ space) + (group-n 2 letter)) + (seq "\\" (group-n 1 (or "l" "L" "o" "O" "AA" "aa" "ae" "AE" "ss" "i")) + word-boundary))) + "Regular expression matching BibTeX special character commands.") + +(defun citeproc-bt--decode (s) + "Decode a BibTeX encoded string." + (replace-regexp-in-string + citeproc-bt--decode-rx + (lambda (x) + (let ((command (match-string 1 x)) + (letter (match-string 2 x))) + (if letter + (or (citeproc-bt--to-ucs command letter) (concat "\\" x)) + (or (assoc-default command citeproc-bt--to-ucs-alist) x)))) + s t t)) + +(defun citeproc-bt--decode-buffer () + "Decode BibTeX encoded characters in the current buffer." + (goto-char (point-min)) + (while (re-search-forward citeproc-bt--decode-rx nil t) + (replace-match + (let ((replacement (let ((command (match-string 1)) + (letter (match-string 2))) + (if letter + (or (citeproc-bt--to-ucs command letter) (concat "\\" (match-string 0))) + (assoc-default command citeproc-bt--to-ucs-alist))))) + replacement)))) + +(defconst citeproc-bt--command-rx + (rx "\\" (1+ (any "a-z" "A-Z")) "{" ; \TEX-COMMAND{ + (group (*? anything)) ; ARGUMENT + "}" ; } + )) + +(defconst citeproc-bt--command-wo-arg-rx + (rx "\\" (1+ (any "a-z" "A-Z")) word-end)) ; \TEX-COMMAND + word-end + +(defconst citeproc-bt--braces-rx + (rx "{" (group (*? anything)) "}")) ; {TEXT} + +(defun citeproc-bt--process-brackets (s &optional lhb rhb) + "Process LaTeX curly brackets in string S. +Optional LHB and RHB specify what to substitute for left and +right braces when they are not enclosing command arguments. +The default is to remove them." + (let* ((result s) + (match t)) + (while match + (cond ((string-match citeproc-bt--command-rx result) + (setq result (replace-match "\\1" t nil result) + match t)) + ((string-match citeproc-bt--command-wo-arg-rx result) + (setq result (replace-match "" t nil result) + match t)) + ((string-match citeproc-bt--braces-rx result) + (setq result (replace-match + (concat lhb "\\1" rhb) + t nil result) + match t)) + (t (setq match nil)))) + result)) + +(defun citeproc-bt--preprocess-for-decode (s) + "Preprocess field S before decoding. +Remove flanking dumb quotes from string S and make some +replacements." + (let ((wo-quotes (if (and (string= (substring s 0 1) "\"") + (string= (substring s -1) "\"")) + (substring s 1 -1) s))) + (string-replace "\\&" "&" wo-quotes))) + +(defun citeproc-bt--to-csl (s &optional with-nocase) + "Convert a BibTeX field S to a CSL one. +If optional WITH-NOCASE is non-nil then convert BibTeX no-case +brackets to the corresponding CSL XML spans." + (if (> (length s) 0) + (--> s + (citeproc-bt--preprocess-for-decode it) + (citeproc-bt--decode it) + (citeproc-bt--process-brackets + it + (when with-nocase "") + (when with-nocase "")) + (citeproc-s-replace-all-seq it '(("\n" . " ") ("~" . " ") ("--" . "–"))) + (s-trim it)) + s)) + +(defun citeproc-bt--to-csl-names (n) + "Return a CSL version of BibTeX names field N." + (let ((name-fields (s-split "\\band\\b" n))) + (mapcar + (lambda (x) + (let ((trimmed (s-trim x))) + (cond + ((string= trimmed "") '((family . ""))) + ;; Presence of equal sign signals extended specification. + ((string-match "=" trimmed) (citeproc-bt--ext-desc-to-csl-name trimmed)) + ;; Brackets indicate corporate entities without name parts. + ((and (string= "{" (substring trimmed 0 1)) + (string= "}" (substring trimmed -1))) + `((literal . ,(citeproc-bt--to-csl (substring trimmed 1 -1))))) + ;; Else standard bib(la)tex name field processing. + (t (citeproc-bt--to-csl-name (citeproc-bt--to-csl trimmed)))))) + name-fields))) + +(defvar citeproc-bt-dropping-particles + '("dela" "il" "sen" "z" "ze") + "List containing dropping particles. Particles whose first word +is not on this list are classified as non-dropping.") + +(defun citeproc-bt--parse-family (f) + "Parse family name tokens F into a csl name-part alist." + (let (family result particle) + (-if-let (firsts (butlast f)) + (progn + (while (and firsts (s-lowercase-p (car firsts))) + (push (pop firsts) particle)) + (when particle + (push (cons (if (member (car particle) citeproc-bt-dropping-particles) + 'dropping-particle + 'non-dropping-particle) + (nreverse particle)) + result)) + (setq family (-concat firsts (last f)))) + (setq family f)) + (push `(family . ,family) result) + result)) + +(defun citeproc-bt--parse-attr-val-field (f) + "Parse biblatex key-val field F into an alist." + (let* ((bracketless (replace-regexp-in-string "[{}]" "" f)) + (equal-split (split-string bracketless "=" t " ")) + (first-attr (intern (string-trim (pop equal-split) "[ \"]+" "[ \"]+"))) + (reversed (nreverse equal-split)) + (result (list (string-trim (pop reversed) "[ \"]+" "[ \"]+")))) + (dolist (elt reversed) + (let ((pos (- (length elt) 2)) + found) + (while (and (< 0 pos) (null found)) + (if (= (aref elt pos) ?,) + (setq found t) + (cl-decf pos))) + (unless found (error "Could not parse biblatex key-value list \"%s\"" f)) + (let ((key (intern (s-trim (substring elt (1+ pos))))) + (val (string-trim (substring elt 0 pos) "[ \"]+" "[ \"]+"))) + (push key (car result)) + (push val result)))) + (push first-attr (car result)) + result)) + +(defun citeproc-bt--ext-desc-to-csl-name (name) + "Return a CSL version of extended biblatex description NAME." + (let* ((parsed (citeproc-bt--parse-attr-val-field name)) + (dropping (string= (alist-get 'useprefix parsed) "false"))) + (--keep (pcase (car it) + ((or 'family 'given 'suffix) it) + ('prefix (cons (if dropping 'dropping-particle 'non-dropping-particle) + (cdr it))) + (_ nil)) + parsed))) + +(defun citeproc-bt--to-csl-name (name) + "Return a CSL version of BibTeX name string NAME." + (let* (result + family + (tokens (-remove #'s-blank-str-p + (citeproc-s-slice-by-matches name "\\(,\\|[[:space:]]+\\)"))) + (parts (-split-on "," tokens))) + (pcase (length parts) + ;; No commas in the name + (1 (let ((name (car parts))) + (-if-let (1st-downcased-idx (-find-index #'s-lowercase-p name)) + (progn (setq family (-slice name 1st-downcased-idx)) + (when (> 1st-downcased-idx 0) + (push `(given . ,(-slice name 0 1st-downcased-idx)) result))) + (setq family (last name)) + (when (> (length name) 1) + (push `(given . ,(-slice name 0 -1)) result))))) + ;; A single comma separates family and last name + (2 (setq family (car parts)) + (push `(given . ,(cadr parts)) result)) + ;; More than one commas + (_ (setq family (car parts)) + (push `(suffix . ,(cadr parts)) result) + (push `(given . ,(cl-caddr parts)) result))) + (setq result (nconc (citeproc-bt--parse-family family) result)) + (--map (cons (car it) (s-join " " (cdr it))) + result))) + +(defun citeproc-bt--to-csl-date (year month) + "Return a CSL version of the date given by YEAR and MONTH. +YEAR and MONTH are the values of the corresponding BibTeX fields, +MONTH might be nil." + (condition-case nil + (let ((csl-year (string-to-number (car (s-match "[[:digit:]]+" year)))) + (csl-month (when month + (assoc-default (downcase month) + citeproc-bt--mon-to-num-alist))) + date) + (when csl-year + (when csl-month (push csl-month date)) + (push csl-year date)) + (list (cons 'date-parts (list date)))) + (error + (error (concat "Couldn't parse year: '%s'" + (when month " and month: '%s'") + " as a date") + year month)))) + +(defun citeproc-bt-entry-to-csl (b) + "Return a CSL form of normalized parsed BibTeX entry B." + (let ((type (assoc-default (downcase (assoc-default "=type=" b)) + citeproc-bt--to-csl-types-alist)) + result year month) + (cl-loop for (key . value) in b do + (let ((key (downcase key)) + (value (citeproc-bt--to-csl value))) + (-if-let (csl-key (assoc-default key citeproc-bt--to-csl-keys-alist)) + ;; Vars mapped simply to a differently named CSL var + (push (cons csl-key value) result) + (pcase key + ((or "author" "editor") ; Name vars + (push (cons (intern key) (citeproc-bt--to-csl-names value)) + result)) + ("=type=" (push (cons 'type type) result)) + ("number" (push (cons (if (string= type "article-journal") 'issue + 'number) + value) + result)) + ;; Date vars that need further processing below + ("year" (setq year value)) + ("month" (setq month value)) + ;; Remaining keys are mapped without change + (_ (push (cons (intern key) value) result)))))) + (when year + (push (cons 'issued (citeproc-bt--to-csl-date year month)) + result)) + result)) + +;; This function is based on the function `org-bibtex-headline' in org-bibtex, +;; written by Bastien Guerry , Carsten Dominik and Eric Schulte . +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. +(defun citeproc-bt-from-org-headline (&optional itemids) + "Return a (KEY . BIBTEX-ENTRY) pair from the headline at point. +The returned BibTeX entry has the same form as produced by +`bibtex-parse-entry'. Return nil if the headline has no +associated bibtex data. If optional ITEMIDS is given then also +return nil if the entry's key is not in ITEMIDS." + (letrec ((val (lambda (key lst) (cdr (assoc key lst)))) + (to (lambda (string) (intern (concat ":" string)))) + (from (lambda (key) (substring (symbol-name key) 1))) + (flatten (lambda (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply flatten e) (list e))) + lsts)))) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get org-bibtex-type-property-name))) + (when (and type (or (null itemids) (member id itemids))) + `(,id . + (("=type=" . ,type) + ,@(remove + nil + (if (and org-bibtex-export-arbitrary-fields + org-bibtex-prefix) + (mapcar + (lambda (kv) + (let ((key (car kv)) (val0 (cdr kv))) + (when (and + (string-match org-bibtex-prefix key) + (not (string= + (downcase (concat org-bibtex-prefix + org-bibtex-type-property-name)) + (downcase key)))) + (cons (downcase (replace-regexp-in-string + org-bibtex-prefix "" key)) + val0)))) + (org-entry-properties nil 'standard)) + (mapcar + (lambda (field) + (let ((value (or (org-bibtex-get (funcall from field)) + (and (eq :title field) + (nth 4 (org-heading-components)))))) + (when value (cons (funcall from field) value)))) + (funcall flatten + (funcall val :required (funcall val (funcall to type) org-bibtex-types)) + (funcall val :optional (funcall val (funcall to type) org-bibtex-types))))))))))) + +(provide 'citeproc-bibtex) + +;;; citeproc-bibtex.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-choose.el b/elpa/citeproc-20240722.1110/citeproc-choose.el new file mode 100644 index 00000000..ee390d51 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-choose.el @@ -0,0 +1,118 @@ +;; citeproc-choose.el --- conditionally rendered CSL elements -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; CSL supports conditional rendering via the cs:choose rendering element, which +;; can contain cs:if, cs:else-if and cs:else elements as children. This file +;; contains functions corresponding to all these elements with some auxiliary +;; functions. + +;; In order to support conditional rendering by cs:choose, the functions +;; corresponding to cs:if, cs:else-if and cs:else (`citeproc--if', +;; `citeproc--else-if', `citeproc--else') return the generalized boolean value +;; of their condition in addition to their rendered content in the form of a +;; (BOOLEAN . CONTENT) pair. + +;;; Code: + +(require 's) + +(require 'citeproc-lib) +(require 'citeproc-context) +(require 'citeproc-date) + +(defun citeproc-choose-eval-conditions (attrs context) + "Eval (possibly complex) boolean conditions in ATTRS." + (-let* ((conditions (citeproc-choose--elementary-conditions + (--remove (eq (car it) 'match) attrs))) + (match (or (alist-get 'match attrs) "all")) + (values (--map (citeproc-choose--eval-elementary-condition (car it) + (intern (cdr it)) + context) + conditions))) + (pcase match + ("all" (--all? it values)) + ("any" (--any? it values)) + ("none" (--none? it values))))) + +(defun citeproc-choose--elementary-conditions (attrs) + "Expand complex conditions in ATTRS into elementary ones. +Return a list of elementary (CONDITION-TYPE . PARAM) pairs." + (cl-mapcan (lambda (x) + (--map (cons (car x) it) + (s-split " " (cdr x)))) + attrs)) + +(defun citeproc-choose--eval-elementary-condition (type param context) + "Evaluate an elementary choose condition of TYPE with PARAM. +TYPE is one of the symbols `variable', `type', `locator', +`is-numeric', `is-uncertain-date', `position' and `disambiguate'. +Return the result of evaluation, which is a generalized boolean." + (pcase type + ('variable (citeproc-var-value param context)) + ('type (string= param (citeproc-var-value 'type context))) + ('locator (string= param (citeproc-var-value 'label context))) + ('is-numeric (let ((val (citeproc-var-value param context))) + (citeproc-lib-numeric-p val))) + ;; We return t iff the first date is uncertain. A more complicated alternative + ;; would be to test the second date of date ranges as well. + ('is-uncertain-date (-when-let (dates (citeproc-var-value param context)) + (citeproc-date-circa (car dates)))) + ('position (and (eq (citeproc-context-mode context) 'cite) + (or (and (eq param 'near-note) (citeproc-var-value 'near-note context)) + (let ((pos (citeproc-var-value 'position context))) + (or (eq param pos) + (and (eq param 'subsequent) + (or (eq pos 'ibid) (eq pos 'ibid-with-locator))) + (and (eq param 'ibid) + (eq pos 'ibid-with-locator))))))) + ('disambiguate (citeproc-var-value 'disambiguate context)))) + +(defmacro citeproc--choose (_attrs _context &rest body) + "Return the content of the first element in BODY with t boolean value. +Return the empty (nil . `text-only') content if there is no such +element." + `(let ((first-true + (--first (car it) (list ,@body)))) + (if first-true + (cdr first-true) + (cons nil (quote text-only))))) + +(defmacro citeproc--if (attrs context &rest body) + "If conditions in ATTRS eval to t return t with rendered BODY. +Return nil otherwise." + `(if (citeproc-choose-eval-conditions ,attrs ,context) + (cons t (citeproc-lib-add-splice-tag + (citeproc-lib-splice-into (list ,@body) 'splice) + 'splice)) + nil)) + +(defalias 'citeproc--else-if 'citeproc--if) + +(defun citeproc--else (_attrs _context &rest body) + "Always return t boolean plus rendered BODY" + (let ((spliced-body (citeproc-lib-splice-into body 'splice))) + (cons t (citeproc-lib-add-splice-tag spliced-body 'splice)))) + +(provide 'citeproc-choose) + +;;; citeproc-choose.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-cite.el b/elpa/citeproc-20240722.1110/citeproc-cite.el new file mode 100644 index 00000000..007b97f5 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-cite.el @@ -0,0 +1,614 @@ +;;; citeproc-cite.el --- cite and citation rendering -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2024 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functionality to render citations and the cites they contain. (Terminology +;; from the CSL standard: "citations consist of one or more cites to individual +;; items".) + +;;; Code: + +(require 'cl-lib) +(require 'dash) +(require 'queue) +(require 's) + +(require 'citeproc-rt) +(require 'citeproc-number) +(require 'citeproc-itemdata) +(require 'citeproc-style) +(require 'citeproc-proc) +(require 'citeproc-formatters) +(require 'citeproc-sort) +(require 'citeproc-subbibs) +(require 'citeproc-date) +(require 'citeproc-biblatex) + + +(declare-function citeproc-style-category "citeproc-style" (style)) + +(cl-defstruct (citeproc-citation (:constructor citeproc-citation-create)) + "A struct representing a citation. +CITES is a list of alists describing individual cites, +NOTE-INDEX is the note index of the citation if it occurs in a + note, +MODE is either nil (for the default citation mode) or one + of the symbols `suppress-author', `textual', `author-only', + `year-only', `title-only', `bib-entry', `locator-only', +SUPPRESS-AFFIXES is non-nil if the citation affixes should be + suppressed, +CAPITALIZE-FIRST is non-nil if the first word of the rendered + citation should be capitalized, +IGNORE-ET-AL is non-nil if et-al settings should be ignored for + the first cite. +GROUPED is used internally to indicate whether the cites were + grouped by the csl processor." + cites note-index mode suppress-affixes capitalize-first + ignore-et-al grouped) + +(defconst citeproc-cite--from-mode-alist + '((textual . ((suppress-author . t))) + (suppress-author . ((suppress-author . t))) + (author-only . ((stop-rendering-at . names))) + (year-only . ((stop-rendering-at . issued))) + (title-only . ((stop-rendering-at . title) (bib-entry . t) (use-short-title . t))) + (bib-entry . ((bib-entry . t))) + (locator-only . ((locator-only . t)))) + "Alist mapping citation modes to corresponding cite-level +key-value pair representations.") + +(defvar citeproc-citation-postprocess-functions nil + "A list of functions to postprocess rendered citations. +Each function takes a single argument, a rich-text, and returns a +post-processed rich-text value. The functions are applied in the +order they appear in the list.") + +(defun citeproc-cite--parse-locator-extra (s) + "Parse extra locator text S into locator-date and locator-extra. +Return a pair (LOCATOR-DATE . LOCATOR-EXTRA) where +- LOCATOR-DATE is a `citeproc-date' struct or nil, and +- LOCATOR-EXTRA is a string or nil." + (let (locator-date locator-extra) + (if (not (string-match-p "^[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" s)) + (setq locator-extra (and (not (s-blank-str-p s)) s)) + (setq locator-date (citeproc-date-parse (citeproc-blt--to-csl-date + (substring s 0 10)))) + (let ((extra (substring s 10))) + (unless (s-blank-str-p extra) (setq locator-extra extra)))) + (cons locator-date locator-extra))) + +(defun citeproc-cite--internalize-locator (cite) + "Internalize a CITE struct's locator by parsing it into fields. +If the \"|\" separator is present in the locator then parse it +into `locator', `locator-extra' and `locator-date', and update +CITE with these fields accordingly. Returns the possibly modified +CITE." + (when-let ((locator (alist-get 'locator cite)) + (separator-pos (cl-position ?| locator))) + (setf (alist-get 'locator cite) (substring locator 0 separator-pos)) + (pcase-let ((`(,locator-date . ,locator-extra) (citeproc-cite--parse-locator-extra + (substring locator (1+ separator-pos))))) + (when locator-date (push (cons 'locator-date locator-date) cite)) + (when locator-extra (push (cons 'locator-extra locator-extra) cite)))) + cite) + +(defun citeproc-cite--varlist (cite) + "Return the varlist belonging to CITE." + (let* ((itd (alist-get 'itd cite)) + (item-vv (citeproc-itemdata-varvals itd)) + ;; OPTIMIZE: Should we do this filtering? + (cite-vv + (--filter (memq (car it) + '(label locator suppress-author suppress-date + stop-rendering-at position near-note + first-reference-note-number ignore-et-al + bib-entry locator-only use-short-title + locator-extra locator-date)) + cite))) + (nconc cite-vv item-vv))) + +(defun citeproc-cite--render (cite style &optional internal-links) + "Render CITE in STYLE, together with its affixes. +If the prefix or suffix in CITE don't contain trailing and +leading spaces then they are added. If the optional +INTERNAL-LINKS is `bib-links' then link cites to the bibliography +regardless of the style type, if `no-links' then don't add +internal links, if nil or `auto' then add internal links based on +the style type (cite-cite links for note styles and cite-bib +links else). For legacy reasons, any other value is treated as +`no-links'." + (-let* ((result nil) + ((&alist 'suffix suff + 'prefix pref + 'bib-entry bib-entry + 'locator-only locator-only + 'stop-rendering-at stop-rendering-at) + cite) + (rt-pref (citeproc-rt-from-str pref)) + (plain-pref (citeproc-rt-to-plain rt-pref)) + (rt-suff (citeproc-rt-from-str suff)) + (plain-suff (citeproc-rt-to-plain rt-suff)) + (mode (if bib-entry 'bib 'cite)) + (varlist (citeproc-cite--varlist cite))) + ;; Remove cite-number when cite is the full bibliography entry. + (when (and (eq mode 'bib) (not stop-rendering-at)) + (push '(citation-number) varlist)) + (let ((rendered-varlist + (citeproc-render-varlist-in-rt + varlist style mode 'display + ;; No link-targets for bib-entry based citations. + (if (eq mode 'bib) 'no-links internal-links) + ;; No external limking for title-only citations, since we link to the + ;; corresponding bibliography entry. + (eq stop-rendering-at 'title)))) + ;; Locator-only cites require extensive post-processing of full cite. + (when locator-only + (setq rendered-varlist (citeproc-rt-locator-w-label rendered-varlist))) + ;; Title-only cites + (when (eq stop-rendering-at 'title) + (when-let* ((cite-no-attr + (citeproc-context-int-link-attrval + style internal-links 'cite (alist-get 'position varlist))) + (cite-no-attr-val (cons cite-no-attr + (alist-get 'citation-number varlist)))) + ;; Add cited-item-no attr to link to the bibliography entry + (setf (car rendered-varlist) + (-snoc (car rendered-varlist) cite-no-attr-val)))) + ;; Add cite prefix and suffix + (when (s-present-p plain-suff) + (push (citeproc-rt-from-str suff) result) + (unless (memql (aref plain-suff 0) '(?, ?\s)) + (push " " result))) + (push rendered-varlist result) + (when (s-present-p plain-pref) + (unless (= (aref plain-pref (1- (length plain-pref))) ?\s) + (push " " result)) + (push rt-pref result)) + (citeproc-rt-join-formatted nil result nil)))) + +(defun citeproc-cite-or-citegroup--render (c style internal-links top-dl gr-dl ys-dl ac-dl) + "Render cite or cite-group C with STYLE. +For the INTERNAL-LINKS argument see `citeproc-cite--render'. +TOP-DL is the top-, GR-DL the group-, YS-DL the year-suffix- and +AC-DL the after-collapse-delimiter to use." + (cond ((and (car c) (memq (car c) '(top group year-suffix-collapsed))) + (let ((delimiter (pcase (car c) + ('top top-dl) + ('group gr-dl) + ('year-suffix-collapsed ys-dl)))) + (cons + nil ; empty attribute list + (nbutlast ; remove last delimiter + (--mapcat (list (citeproc-cite-or-citegroup--render + it style internal-links top-dl gr-dl ys-dl ac-dl) + (if (and (car it) (memq (car it) '(group year-suffix-collapsed))) + ac-dl + delimiter)) + (cdr c)))))) + ((eq (car c) 'range) + (list nil (citeproc-cite--render (cl-second c) style internal-links) + "–" (citeproc-cite--render (cl-third c) style internal-links))) + (t (citeproc-cite--render c style internal-links)))) + +(defun citeproc-citation--render (c proc &optional internal-links) + "Render citation C with CSL processor PROC. +For the optional INTERNAL-LINKS argument see +`citeproc-cite--render'." + (let* ((style (citeproc-proc-style proc)) + (punct-in-quote + (string= (alist-get 'punctuation-in-quote (citeproc-style-locale-opts style)) + "true")) + (cites (citeproc-citation-cites c)) + (cite-attrs (citeproc-style-cite-layout-attrs style)) + (cite-layout-dl (alist-get 'delimiter cite-attrs))) + ;; Remove delimiters from cite-attrs -- they are rendered 'manually' because of + ;; the delimiter-after-collapse complications in rendering. Also remove affixes + ;; if requested. + (setq cite-attrs + (if (citeproc-citation-suppress-affixes c) + (--remove (memq (car it) '(delimiter prefix suffix)) cite-attrs) + (--remove (eq (car it) 'delimiter) cite-attrs))) + ;; Generate rendered cites + (let ((rendered-cites + (cond + ((citeproc-citation-grouped c) + (let ((gr-dl + (alist-get 'cite-group-delimiter (citeproc-style-cite-opts style))) + (ys-dl + (alist-get 'year-suffix-delimiter (citeproc-style-cite-opts style))) + (aft-coll-dl + (alist-get + 'after-collapse-delimiter (citeproc-style-cite-opts style)))) + (cdr (citeproc-cite-or-citegroup--render + (cons 'top cites) ; indicate top level input + style internal-links cite-layout-dl gr-dl ys-dl aft-coll-dl)))) + ((cdr cites) + (cdr (--mapcat + (list cite-layout-dl (citeproc-cite--render it style internal-links)) + cites))) + (t + (list (citeproc-cite--render (car cites) style internal-links)))))) + ;; Calculate inner and outer citation attrs (affixes go inside) + (let* ((non-affixes (--remove (memq (car it) '(prefix suffix delimiter)) cite-attrs)) + (affixes (--filter (memq (car it) '(prefix suffix)) cite-attrs)) + (outer-attrs (and affixes non-affixes)) + (result + (citeproc-rt-cull-spaces-puncts + (citeproc-rt-finalize + (citeproc-rt-render-affixes + (citeproc-rt-join-formatted (if outer-attrs affixes cite-attrs) + rendered-cites nil) + t) + punct-in-quote)))) + ;; Add outer (non-affix attrs) if needed + (when outer-attrs + (setq result (list outer-attrs result))) + ;; Prepend author to textual citations + (when (and (eq (citeproc-citation-mode c) 'textual) + (not (member (citeproc-style-category style) '("numeric" "label")))) + (let* ((first-elt (car cites)) ;; First elt is either a cite or a cite group. + ;; If the latter then we need to locate the + ;; first cite as the 2nd element of the first + ;; cite group. + (first-cite (if (eq 'group (car first-elt)) + (cadr first-elt) + first-elt)) + (author-cite + (append '((suppress-author . nil) (stop-rendering-at . names) + (prefix) (suffix) (locator)) + first-cite)) + (rendered-author (citeproc-cite--render author-cite style 'no-links))) + (when (listp rendered-author) + (setq result `(nil ,rendered-author " " ,result))))) + ;; Capitalize first + (when (citeproc-citation-capitalize-first c) + (setq result (citeproc-rt-change-case result #'citeproc-s-capitalize-first))) + ;; Run the citation postprocessing hook + (dolist (fn citeproc-citation-postprocess-functions) + (setq result (funcall fn result))) + result)))) + +(defun citeproc-cites--collapse-indexed (cites index-getter no-span-pred) + "Collapse continuously indexed cites in CITES. +INDEX-GETTER is a function from cites to numeric indices, +NO-SPAN-PRED is a predicate that returns non-nil for cites that +cannot be part of a span. Return the collapsed cites list or nil +if no cites were collapsed." + (let (group-len start-cite prev-index end-cite result) + (dolist (cite cites) + (let* ((cur-index (funcall index-getter cite)) + (no-span-elt (funcall no-span-pred cite)) + (subsequent (and prev-index (= (1+ prev-index) cur-index)))) + ;; Process ending current group + (when (and group-len (or no-span-elt (not subsequent))) + (setq result (nconc (citeproc-cite-range--collapse + start-cite end-cite + group-len) + result))) + (cond (no-span-elt ; Not only cite-no + (push cite result) + (setq group-len nil)) + ((or (not group-len) (not subsequent)) ; New group starts + (setq group-len 1 + start-cite cite + prev-index cur-index)) + (t ; Group continues + (cl-incf group-len) + (setq end-cite cite + prev-index cur-index))))) + ;; Process the last group + (when group-len + (setq result (nconc (citeproc-cite-range--collapse + start-cite end-cite group-len) + result))) + (if (/= (length cites) (length result)) + (nreverse result) + nil))) + +(defun citeproc-cite-range--collapse (start-cite end-cite len) + "Collapse cite span with START-CITE, END-CITE of LEN length. +START-CITE end END-CITE is the first and last rendered cites of +the span." + (pcase len + (1 (list start-cite)) + (2 (list end-cite start-cite)) + (_ (list (list 'range start-cite end-cite))))) + +(defun citeproc-citation--collapse-num-citeranges (citation) + "Collapse numbered ranges in CITATION." + (let* ((cites (citeproc-citation-cites citation)) + (cites-length (length cites))) + (when (> cites-length 2) + (-when-let (collapsed + (citeproc-cites--collapse-indexed + cites + (lambda (x) + (string-to-number + (alist-get 'citation-number (citeproc-cite--varlist x)))) + (lambda (x) (alist-get 'locator (citeproc-cite--varlist x))))) + (setf (citeproc-citation-cites citation) collapsed + (citeproc-citation-grouped citation) t))))) + +(defun citeproc-cites--collapse-suff-citeranges (cites) + "Collapse continuously year-suffixed CITES." + (or (citeproc-cites--collapse-indexed + cites + (lambda (x) + (string-to-char (alist-get 'year-suffix (citeproc-cite--varlist x) " "))) + (lambda (_x) nil)) + cites)) + +(defun citeproc-citation--render-formatted-citation (c proc format &optional internal-links) + "Render citation C with csl processor PROC in FORMAT. +For the optional INTERNAL-LINKS argument see +`citeproc-cite--render'." + (let ((fmt (citeproc-formatter-for-format format))) + (funcall (citeproc-formatter-cite fmt) + (funcall (citeproc-formatter-rt fmt) + (citeproc-citation--render c proc internal-links))))) + +(defun citeproc-citation--sort-cites (citation proc) + "Sort cites in CITATION for processor PROC." + (let ((cites (citeproc-citation-cites citation))) + (when (cdr cites) + (let* ((style (citeproc-proc-style proc)) + (sort-orders (citeproc-style-cite-sort-orders style))) + (setf (citeproc-citation-cites citation) + (sort + (--map (cons (cons 'key ; add keys to the cites as extra attr + (citeproc-sort--render-keys style (citeproc-cite--varlist it) 'cite)) + it) + cites) + (lambda (x y) (citeproc-sort--compare-keylists (cdar x) (cdar y) sort-orders)))))))) + +(defun citeproc-proc-sort-cites (proc) + "Sort cites in all citations of PROC." + (when (citeproc-style-cite-sort (citeproc-proc-style proc)) + (dolist (citation (queue-head (citeproc-proc-citations proc))) + (citeproc-citation--sort-cites citation proc)))) + +(defun citeproc-proc-apply-citation-modes (proc) + "Apply mode to the first cite in each citation in PROC." + (dolist (citation (queue-head (citeproc-proc-citations proc))) + (let ((mode (citeproc-citation-mode citation)) + (cites (citeproc-citation-cites citation)) + (ignore-et-al (citeproc-citation-ignore-et-al citation))) + (-when-let (mode-rep + (alist-get mode citeproc-cite--from-mode-alist)) + (setf (car cites) (nconc (car cites) mode-rep))) + (when ignore-et-al + (push '(ignore-et-al . t) (car cites)))))) + +(defun citeproc-proc-group-and-collapse-cites (proc) + "Group and collapse cites in all citations of PROC." + (let* ((cite-opts (citeproc-style-cite-opts (citeproc-proc-style proc))) + (group-delim (alist-get 'cite-group-delimiter cite-opts)) + (collapse-type (alist-get 'collapse cite-opts)) + (collapse-year-type + (when collapse-type + (let ((cy (member collapse-type + '("year" "year-suffix" "year-suffix-ranged")))) + (and cy (car cy)))))) + ;; Collapse (and group) according to collapse type + (cond ((or group-delim collapse-year-type) + ;; Group and possibly collapse + (dolist (citation (queue-head (citeproc-proc-citations proc))) + (citeproc-citation--group-and-collapse-cites citation proc collapse-type))) + ;; Collapse numeric cites + ((string= collapse-type "citation-number") + (dolist (citation (queue-head (citeproc-proc-citations proc))) + (citeproc-citation--collapse-num-citeranges citation)))))) + +(defun citeproc-citation--group-and-collapse-cites (c proc &optional collapse-type) + "Divide items in citation C in place into groups for PROC. +Apart from movement necessary for grouping, the relative +positions of cites in C is kept. If optional COLLAPSE-TYPE is +given then collapse the groups accordingly." + (let ((cites (citeproc-citation-cites c))) + (when (cdr cites) + (let (groups) + (dolist (cite cites) + (let ((g-ind + ;; Cites are in the same group iff the cdrs of the rendered cite's first + ;; name-var are equal. The cdr is taken because we ignore attributes, in + ;; particular the cited-item-no attribute which is added when the cite consists + ;; entirely of the rendered name var + (--find-index (equal (cdr (citeproc-cite--first-namevar-cont cite proc)) + (cdr (citeproc-cite--first-namevar-cont (car it) proc))) + groups))) + (if g-ind + (push cite (nth g-ind groups)) + (push (list cite) groups)))) + (unless (= (length groups) (length cites)) + (setf (citeproc-citation-cites c) + (nreverse + (--map (if (cdr it) + (cons 'group + (pcase collapse-type + ("year" + (citeproc-citation-group--collapse-year (nreverse it))) + ("year-suffix" + (citeproc-citation-group--collapse-ys (nreverse it) proc nil)) + ("year-suffix-ranged" + (citeproc-citation-group--collapse-ys (nreverse it) proc t)) + (_ (nreverse it)))) + (car it)) + groups)) + (citeproc-citation-grouped c) t)))))) + +(defun citeproc-citation-group--collapse-year (cites) + "Collapse year in group CITES." + (cons (car cites) + (--map (cons '(suppress-author . t) it) + (cdr cites)))) + +(defun citeproc-citation-group--collapse-ys (cites proc collapse-ranges) + "Collapse year and suffix in group CITES using PROC. +If optional COLLAPSE-RANGES is non-nil then collapse year-suffix +ranges." + (let ((first t) (groups (list (list (car cites)))) + prev-datevar-cont prev-locator) + (dolist (cite cites) + (let* ((varlist (citeproc-cite--varlist cite)) + (datevar-cont (cadr (citeproc-cite--first-datevar-cont cite proc))) + (locator (alist-get 'locator varlist))) + (cond (first + (setq first nil)) + ((or prev-locator + locator + (not (alist-get 'year-suffix varlist)) + (not (equal datevar-cont prev-datevar-cont))) + (push (list (cons '(suppress-author . t) + cite)) + groups)) + (t + (push (cons '(suppress-date . t) + (cons '(suppress-author . t) + cite)) + (car groups)))) + (setq prev-datevar-cont datevar-cont + prev-locator locator)) + cites) + (nreverse + (--map (if (cdr it) + (cons 'year-suffix-collapsed + (if (and collapse-ranges (> (length cites) 2)) + (citeproc-cites--collapse-suff-citeranges (nreverse it)) + (nreverse it))) + (car it)) + groups)))) + +(defun citeproc-citations--itd-referred-p (itd citations) + "Whether ITD is referred to in CITATIONS." + (let ((cites (--mapcat (citeproc-citation-cites it) citations))) + (--any-p (eq itd (alist-get 'itd it)) cites))) + +(defun citeproc-cite--update-nn-queue (q index nnd) + "Remove too distant citations from near-notes queue Q. +INDEX is the actual note-index, NND is the near-note-distance." + (while (and (queue-head q) + (< nnd (- index + (citeproc-citation-note-index (queue-first q))))) + (queue-dequeue q))) + +(defun citeproc-cite--loc-equal-p (s1 s2) + "Whether locator strings S1 and S2 refer to the same location." + (if (and (citeproc-lib-numeric-p s1) (citeproc-lib-numeric-p s2)) + (equal (citeproc-number-extract s1) (citeproc-number-extract s2)) + (string= (s-trim s1) (s-trim s2)))) + +(defvar citeproc-disambiguation-cite-pos 'last + "Which cite position should be the basis of cite disambiguation. +Possible values are `last', `first' and `subsequent'.") + +(defun citeproc-proc-update-positions (proc) + "Update all position-related fields in PROC." + (citeproc-proc-delete-occurrence-info proc) + (let* ((ctns (queue-head (citeproc-proc-citations proc))) + (cite-opts (citeproc-style-cite-opts (citeproc-proc-style proc))) + (nnd (string-to-number + (or (alist-get 'near-note-distance cite-opts) + "5"))) + (near-note-ctns (make-queue)) + prev-itd prev-loc prev-label) + (unless (eq citeproc-disambiguation-cite-pos 'last) + (dolist (itd (hash-table-values + (citeproc-proc-itemdata proc))) + (setf (citeproc-itemdata-disamb-pos itd) citeproc-disambiguation-cite-pos))) + (dolist (ctn ctns) + (let* ((note-ind (citeproc-citation-note-index ctn)) + (cites (citeproc-citation-cites ctn)) + (single-cite (not (cdr cites)))) + (when note-ind (citeproc-cite--update-nn-queue near-note-ctns note-ind nnd)) + (let (seen-itds) + (while cites + (let* ((cite (car cites)) + (itd (alist-get 'itd cite)) + (locator (alist-get 'locator cite)) + (label (alist-get 'label cite)) + (pos (if (citeproc-itemdata-occurred-before itd) + (if (eq itd prev-itd) + (if prev-loc + (if locator + (if (and (citeproc-cite--loc-equal-p prev-loc locator) + (string= prev-label label)) + 'ibid + 'ibid-with-locator) + 'subsequent) + (if locator 'ibid-with-locator 'ibid)) + 'subsequent) + 'first))) + (when (and note-ind + (or (citeproc-citations--itd-referred-p itd (queue-head near-note-ctns)) + (memq itd seen-itds))) + (setf (alist-get 'near-note (car cites)) t)) + (setf (alist-get 'position (car cites)) pos + prev-itd itd + prev-loc locator + prev-label label) + (when (eq citeproc-disambiguation-cite-pos 'last) + (citeproc-itd-update-disamb-pos itd pos)) + (let ((prev-occurrence (citeproc-itemdata-occurred-before itd))) + (if prev-occurrence + (unless (eq t prev-occurrence) + (setf (alist-get 'first-reference-note-number (car cites)) + (number-to-string prev-occurrence))) + (setf (citeproc-itemdata-occurred-before itd) (or note-ind t)))) + (push itd seen-itds) + (pop cites)))) + (unless single-cite + (setq prev-itd nil prev-loc nil prev-label nil)) + (when note-ind (queue-append near-note-ctns ctn)))))) + +(defun citeproc-proc-finalize (proc) + "Finalize processor PROC by sorting and disambiguating items." + (unless (citeproc-proc-finalized proc) + (citeproc-proc-process-uncited proc) + (citeproc-sb-add-subbib-info proc) + (citeproc-sb-prune-unrendered proc) + (citeproc-proc-update-sortkeys proc) + (citeproc-proc-sort-itds proc) + (citeproc-proc-update-positions proc) + (citeproc-proc-disamb proc) + (citeproc-proc-sort-cites proc) + (citeproc-proc-apply-citation-modes proc) + (citeproc-proc-group-and-collapse-cites proc) + (setf (citeproc-proc-finalized proc) t))) + +(defun citeproc-cite--first-namevar-cont (cite proc) + "Return the first raw name-var node of CITE rendered with PROC." + (citeproc-rt-find-first-node + (citeproc-itd-rt-cite (alist-get 'itd cite) (citeproc-proc-style proc)) + (lambda (x) + (and (consp x) (memq (alist-get 'rendered-var (car x)) + citeproc--name-vars))))) + +(defun citeproc-cite--first-datevar-cont (cite proc) + "Return the first raw date-var node of CITE rendered with PROC." + (citeproc-rt-find-first-node + (citeproc-itd-rt-cite (alist-get 'itd cite) (citeproc-proc-style proc)) + (lambda (x) + (and (consp x) (memq (alist-get 'rendered-var (car x)) + citeproc--date-vars))))) +(provide 'citeproc-cite) + +;;; citeproc-cite.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-context.el b/elpa/citeproc-20240722.1110/citeproc-context.el new file mode 100644 index 00000000..7af136dc --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-context.el @@ -0,0 +1,290 @@ +;;; citeproc-context.el --- rendering context for CSL elements -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Provides the `citeproc-context' CL-structure type to represent rendering +;; contexts for CSL elements, and functions for accessing context-dependent +;; information (variable and term values etc.). Also contains some functions +;; that perform context-dependent formatting (e.g., quoting). + +;;; Code: + +(require 'let-alist) +(require 'subr-x) + +(require 'citeproc-lib) +(require 'citeproc-rt) +(require 'citeproc-term) +(require 'citeproc-prange) +(require 'citeproc-style) + +(cl-defstruct (citeproc-context (:constructor citeproc-context--create)) + "A struct representing the context for rendering CSL elements." + vars macros terms date-text date-numeric opts locale-opts + mode render-mode render-year-suffix no-external-links locale) + +(defun citeproc-context-create (var-alist style mode render-mode + &optional no-external-links) + "Create a citeproc-context struct from var-values VAR-ALIST and csl style STYLE. +MODE is either `bib' or `cite', RENDER-MODE is `display' or `sort'." + (citeproc-context--create + :vars var-alist + :macros (citeproc-style-macros style) + :terms (citeproc-style-terms style) + :date-text (citeproc-style-date-text style) + :date-numeric (citeproc-style-date-numeric style) + :opts (citeproc-style-global-opts style mode) + :locale (citeproc-style-locale style) + :locale-opts (citeproc-style-locale-opts style) + :mode mode + :render-mode render-mode + :render-year-suffix (not (citeproc-style-uses-ys-var style)) + :no-external-links no-external-links)) + +(defconst citeproc--short-long-var-alist + '((title . title-short) (container-title . container-title-short)) + "Alist mapping the long form of variables names to their short form.") + +(defun citeproc-var-value (var context &optional form) + "Return the value of csl variable VAR in CONTEXT. +VAR is a symbol, CONTEXT is a `citeproc-context' struct, and the +optional FORM can be nil, `short' or `long'." + (let ((var-vals (citeproc-context-vars context))) + (if (or (eq form 'short) + ;; Also use the short form of title when the cite contains the + ;; (use-short-title . t) pair. This is used for title-only citations. + (and (eq var 'title) (alist-get 'use-short-title var-vals))) + (-if-let* ((short-var (alist-get var citeproc--short-long-var-alist)) + (short-var-val (alist-get short-var var-vals))) + short-var-val + (alist-get var var-vals)) + (let ((var-val (alist-get var var-vals))) + (if (and var-val (or (and (eq var 'locator) + (string= (citeproc-var-value 'label context) "page")) + (eq var 'page))) + (let ((prange-format (citeproc-lib-intern (alist-get 'page-range-format + (citeproc-context-opts context)))) + (sep (or (citeproc-term-text-from-terms "page-range-delimiter" + (citeproc-context-terms context)) + "–"))) + (citeproc-rt-from-str (citeproc-prange-render var-val prange-format sep))) + var-val))))) + +(defun citeproc-locator-label (context) + "Return the current locator label variable from CONTEXT." + (citeproc-var-value 'label context)) + +(defun citeproc-rt-quote (rt context) + "Return the quoted version of rich-text RT using CONTEXT." + (let ((oq (citeproc-term-get-text "open-quote" context)) + (cq (citeproc-term-get-text "close-quote" context)) + (oiq (citeproc-term-get-text "open-inner-quote" context)) + (ciq (citeproc-term-get-text "close-inner-quote" context))) + `(,oq ,@(citeproc-rt-replace-all-sim `((,oq . ,oiq) (,cq . ,ciq) + (,oiq . ,oq) (,ciq . ,cq)) + (format "\\(%s\\|%s\\|%s\\|%s\\)" oq cq oiq ciq) + rt) + ,cq))) + +(defun citeproc-rt-textcased (rts case context) + "Return rich-text content RTS in text-case CASE using CONTEXT. +CASE is one of the following: `lowercase', `uppercase', +`capitalize-first', `capitalize-all', `sentence', `title'." + (pcase case + ('uppercase + (citeproc-rt-map-strings #'upcase rts t)) + ('lowercase + (citeproc-rt-map-strings #'downcase rts t)) + ('capitalize-first + (--map (citeproc-rt-change-case it #'citeproc-s-capitalize-first) rts)) + ('capitalize-all + (--map (citeproc-rt-change-case it #'citeproc-s-capitalize-all) rts)) + ('sentence + (--map (citeproc-rt-change-case it #'citeproc-s-sentence-case) rts)) + ('title + (let ((locale (citeproc-context-locale context)) + (language (citeproc-var-value 'language context))) + (if (or (and language (string-prefix-p "en" language)) + (and (null language) + (or (and locale (string-prefix-p "en" locale)) + (null locale)))) + (--map (citeproc-rt-change-case it #'citeproc-s-title-case) rts) + rts))))) + +(defun citeproc-rt-join-formatted (attrs rts context) + "Join and format according to ATTRS the rich-texts in RTS." + (let-alist attrs + (let ((result (delq nil rts))) + (when .text-case + (setq result (citeproc-rt-textcased result (intern .text-case) context))) + (when (string= .strip-periods "true") (setq result (citeproc-rt-strip-periods result))) + (when (string= .quotes "true") (setq result (citeproc-rt-quote result context))) + (push (citeproc-rt-select-attrs attrs citeproc-rt-ext-format-attrs) result) + (if (and .delimiter + (> (length result) 2)) + result + (citeproc-rt-simplify-shallow result))))) + +(defun citeproc-rt-format-single (attrs rt context) + "Format according to ATTRS rich-text RT using CONTEXT." + (if (or (not rt) (and (char-or-string-p rt) (string= rt ""))) + nil + (citeproc-rt-join-formatted attrs (list rt) context))) + +(defun citeproc-rt-typed-join (attrs typed-rts context) + "Join and format according to ATTRS contents in list TYPED-RTS. +TYPED RTS is a list of (RICH-TEXT . TYPE) pairs" + (-let* ((types (--map (cdr it) typed-rts)) + (type (cond ((--all? (eq it 'text-only) types) + 'text-only) + ((--any? (eq it 'present-var) types) + 'present-var) + (t 'empty-vars)))) + (cons (citeproc-rt-join-formatted attrs + (--map (car it) typed-rts) + context) + type))) + +(defun citeproc-term-get-text (term context) + "Return the first text associated with TERM in CONTEXT." + (citeproc-term-text-from-terms term (citeproc-context-terms context))) + +(defconst citeproc--term-form-fallback-alist + '((verb-short . verb) + (symbol . short) + (verb . long) + (short . long)) + "Alist containing the fallback form for each term form.") + +(defun citeproc-term-inflected-text (term form number context) + "Return the text associated with TERM having FORM and NUMBER." + (let ((matches + (--select (string= term (citeproc-term-name it)) + (citeproc-context-terms context)))) + (if (not matches) nil + (let (match) + (while (and (not match) form) + (setq match (--first (and (eq form (citeproc-term-form it)) + (or (not (citeproc-term-number it)) + (eq number (citeproc-term-number it)))) + matches)) + (unless match + (setq form (alist-get form citeproc--term-form-fallback-alist)))) + (when match (citeproc-term-text match)))))) + +(defun citeproc-term-get-gender (term context) + "Return the gender of TERM or nil if none is given." + (-if-let (match + (--first (and (string= (citeproc-term-name it) term) + (citeproc-term-gender it) + (eq (citeproc-term-form it) 'long)) + (citeproc-context-terms context))) + (citeproc-term-gender match) + nil)) + +(defun citeproc-context-int-link-attrval (style internal-links mode cite-pos) + "Return an appropriate attribute to represent internal linking info. +INTERNAL-LINKS is the internal linking mode, see the +documentation of `citeproc-render-varlist-in-rt', while MODE is +the rendering mode, `bib' or `cite', and CITE-POS is a cite +position. Returns an appropriate attribute to be added or nil if +no internal links should be produced." + (let ((note-style (citeproc-style-cite-note style))) + (unless (or (and internal-links (not (memq internal-links '(auto bib-links)))) + (and note-style (eq mode 'bib) (or (null internal-links) + (eq internal-links 'auto)))) + (if (and note-style (not (eq internal-links 'bib-links))) + ;; For note styles link subsequent cites to the first ones. + (if (eq cite-pos 'first) 'bib-item-no 'cited-item-no) + ;; Else link each cite to the corresponding bib item. + (if (eq mode 'cite) 'cited-item-no 'bib-item-no))))) + +(defun citeproc-context-maybe-stop-rendering + (trigger context result &optional var) + "Stop rendering if a (`stop-rendering-at'. TRIGGER) pair is present in CONTEXT. +In case of stopping return with RESULT. If the optional VAR +symbol is non-nil then rendering is stopped only if VAR is eq to +TRIGGER." + (if (and (eq trigger (alist-get 'stop-rendering-at (citeproc-context-vars context))) + (or (not var) (eq var trigger)) + (eq (cdr result) 'present-var)) + (let ((rt-result (car result))) + (push '(stopped-rendering . t) (car rt-result)) + (throw 'stop-rendering (citeproc-rt-render-affixes rt-result))) + result)) + +(defun citeproc-render-varlist-in-rt (var-alist style mode render-mode &optional + internal-links no-external-links) + "Render an item described by VAR-ALIST with STYLE in rich-text. +Does NOT finalize the rich-text rendering. MODE is either `bib' +or `cite', RENDER-MODE is `display' or `sort'. + If the optional INTERNAL-LINKS is `bib-links' then link cites +to the bibliography regardless of the style type, if `no-links' +then don't add internal links, if nil or `auto' then add internal +links based on the style type (cite-cite links for note styles +and cite-bib links else). For legacy reasons, any other value is +treated as `no-links'. + If the optional NO-EXTERNAL-LINKS is non-nil then don't add +external links." + (-if-let (unprocessed-id (alist-get 'unprocessed-with-id var-alist)) + ;; Itemid received no associated csl fields from the getter! + (list nil (concat "NO_ITEM_DATA:" unprocessed-id)) + (let* ((context (citeproc-context-create var-alist style mode render-mode + no-external-links)) + (layout-fun-accessor (if (eq mode 'cite) 'citeproc-style-cite-layout + 'citeproc-style-bib-layout)) + (layout-fun (funcall layout-fun-accessor style))) + (if (null layout-fun) "[NO BIBLIOGRAPHY LAYOUT IN CSL STYLE]" + (let ((rendered (catch 'stop-rendering + (funcall layout-fun context)))) + ;; Finalize external linking by linking the title if needed + (when (and (eq mode 'bib) (not no-external-links)) + (-when-let ((var . val) (--any (assoc it var-alist) + citeproc--linked-vars)) + (unless (cl-intersection (citeproc-rt-rendered-vars rendered) + citeproc--linked-vars) + (citeproc-rt-link-title rendered + (concat (alist-get var citeproc--link-prefix-alist + "") + (alist-get var var-alist)))))) + ;; Add appropriate item-no information + (when-let* ((cite-no-attr + (citeproc-context-int-link-attrval + style internal-links mode (alist-get 'position var-alist))) + (cite-no-attr-val (cons cite-no-attr + (alist-get 'citation-number var-alist)))) + (cond ((consp rendered) (setf (car rendered) + (-snoc (car rendered) cite-no-attr-val))) + ((stringp rendered) (setq rendered + (list (list cite-no-attr-val) rendered))))) + ;; Add year-suffix if needed + (-if-let (year-suffix (alist-get 'year-suffix var-alist)) + (car (citeproc-rt-add-year-suffix + rendered + ;; year suffix is empty if already rendered by var just to delete the + ;; suppressed date + (if (citeproc-style-uses-ys-var style) "" year-suffix))) + rendered)))))) + +(provide 'citeproc-context) + +;;; citeproc-context.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-date.el b/elpa/citeproc-20240722.1110/citeproc-date.el new file mode 100644 index 00000000..e514909b --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-date.el @@ -0,0 +1,281 @@ +;;; citeproc-date.el --- CSL date rendering -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Structure type and functions to render CSL date elements. + +;;; Code: + +(require 'subr-x) +(require 'cl-lib) +(require 'dash) +(require 'let-alist) +(require 's) + +(require 'citeproc-lib) +(require 'citeproc-rt) +(require 'citeproc-context) +(require 'citeproc-number) + +(cl-defstruct (citeproc-date (:constructor citeproc-date-create)) + "Struct for representing dates. +Slots YEAR, MONTH, DAY are integers, while SEASON and CIRCA are +booleans. SEASON indicates whether the integer in slot MONTH is +to be interpreted as a season number." + (year nil) (month nil) (day nil) (season nil) (circa nil)) + +(defun citeproc-date-parse (date-rep) + "Parse CSL json date repr. DATE-REP into an internal one." + (let-alist date-rep + (--map (citeproc-date--conv it .season .circa) .date-parts))) + +(defun citeproc-date--conv (dates &optional season circa) + "Convert date-part list DATES to a citeproc-date struct. +Set the remaining slots to the values SEASON and CIRCA." + (-let* ((numeric + (--map (if (stringp it) (string-to-number it) it) dates)) + ((year month day) numeric)) + (citeproc-date-create :year year :month month :day day + :season season :circa circa))) + +(defun citeproc-date--partattrs-for-sort (part-attrs) + "Return a sort-key version of PART-ATTRS." + (let (result) + (when (assoc 'day part-attrs) + (push '(day . ((form . "numeric-leading-zeros"))) result)) + (when (assoc 'month part-attrs) + (push '(month . ((form . "numeric-leading-zeros"))) result)) + (when (assoc 'year part-attrs) + (push '(year . ((form . "long"))) result)) + result)) + +(defun citeproc--date (attrs context &rest body) + "Function corresponding to the date CSL element." + (-let* (((&alist 'variable var + 'form form) + attrs) + (var-sym (intern var)) + (parsed-dates (citeproc-var-value var-sym context)) + ((d1 d2) parsed-dates) + (result + (if d1 + (progn + (when form + (let ((localized (citeproc-date--localized-attrs attrs body context))) + (setq attrs (car localized) + body (cdr localized)))) + (when (eq (citeproc-context-render-mode context) 'sort) + (setq body (citeproc-date--partattrs-for-sort body))) + (if (citeproc-date--renders-with-attrs-p d1 body) + (progn + (push `(rendered-var . ,(intern var)) attrs) + (cons (if d2 + (citeproc-date--render-range d1 d2 attrs body context) + (citeproc-date--render d1 attrs body context)) + 'present-var)) + (cons nil 'empty-vars))) + (cons nil 'empty-vars)))) + ;; Handle `year' citation mode by stopping if needed + (citeproc-context-maybe-stop-rendering 'issued context result var-sym))) + +(defun citeproc--date-part (attrs _context &rest _body) + "Function corresponding to the date-part CSL element." + (cons (intern (alist-get 'name attrs)) + attrs)) + +(defun citeproc-date--renders-with-attrs-p (date part-attrs) + "Whether DATE contains date-parts corresponding to PART-ATTRS." + (let ((date-parts (mapcar #'car part-attrs))) + (or (memq 'year date-parts) ; All dates contain a year + (and (memq 'month date-parts) (citeproc-date-month date)) + (and (memq 'day date-parts) (citeproc-date-day date))))) + +(defun citeproc-date--localized-attrs (attrs part-attrs context) + "Return the localized date attrs merged with date ATTRS and date PART-ATTRS." + (-let* (((&alist 'form form + 'date-parts date-parts) + attrs) + ((loc-attrs . loc-part-attrs) + (if (string= form "text") (citeproc-context-date-text context) + (citeproc-context-date-numeric context)))) + (pcase (citeproc-lib-intern date-parts) + ('year + (setq loc-part-attrs + (--select (eq (car it) 'year) loc-part-attrs))) + ('year-month + (setq loc-part-attrs + (--select (memq (car it) '(year month)) loc-part-attrs)))) + (cons (-concat attrs loc-attrs) + (--map (cons (car it) + (-concat (alist-get (car it) part-attrs) (cdr it))) + loc-part-attrs)))) + +(defun citeproc-date--render (d attrs part-attrs context) + "Render citeproc-date D according to formatting in ATTRS and PART-ATTRS. +Return a rich-text content." + (if (citeproc-var-value 'suppress-date context) + (citeproc-rt-format-single attrs "" context) + (let ((rendered-date (citeproc-date--render-parts d part-attrs context))) + (citeproc-rt-join-formatted attrs rendered-date context)))) + +(defun citeproc-date--render-parts (d part-attrs context &optional no-last-suffix) + "Render the parts of citeproc-date D according to PART-ATTRS. +Return a list of rich-text contents. If optional NO-LAST-SUFFIX +is non-nil then remove the suffix attribute of the last rendered +element (used for date range rendering)." + (let ((result (--map (pcase (car it) + ('year (citeproc-date--render-year d (cdr it) context)) + ('month (citeproc-date--render-month d (cdr it) context)) + ('day (citeproc-date--render-day d (cdr it) context))) + part-attrs))) + (-if-let* ((n-l-s no-last-suffix) + (last (car (last result))) + (wo-suffix (and (consp last) + (cons (--remove (eq 'suffix (car it)) (car last)) + (cdr last))))) + (-snoc (butlast result) wo-suffix) + result))) + +(defun citeproc-date--render-range-parts (d1 d2 part-attrs sep context) + "Render the parts of citeproc-dates D1 and D2 according to PART-ATTRS. +PART-ATTRS is a list containing either part-attrs or lists of part-attrs. +The formers are only rendered for D1, while the latters are rendered for both +D1 and D2. Return a list of rich-text contents." + (--mapcat (pcase (car it) + ('year (list (citeproc-date--render-year d1 (cdr it) context))) + ('month (list (citeproc-date--render-month d1 (cdr it) context))) + ('day (list (citeproc-date--render-day d1 (cdr it) context))) + (_ (-concat (citeproc-date--render-parts d1 it context t) + (list sep) + (citeproc-date--render-parts d2 it context)))) + part-attrs)) + +(defun citeproc-date--render-range (d1 d2 attrs part-attrs context) + "Render the range given by dates D1 D2 according to attrs." + (if (citeproc-var-value 'suppress-date context) + (citeproc-rt-format-single attrs "" context) + (let* ((gran (min (citeproc-date--gran d1) + (citeproc-date--attrs-gran part-attrs))) + (range-sep (or (alist-get 'range-delimiter + (alist-get (elt '(year month day) gran) + part-attrs)) + "–")) + (range-p-attrs + (cond ((/= (citeproc-date-year d1) (citeproc-date-year d2)) + (list part-attrs)) + ((/= (citeproc-date-month d1) (citeproc-date-month d2)) + (let ((year-part (--find (eq 'year (car it)) + part-attrs)) + (attrs-wo-year + (--remove (eq 'year (car it)) + part-attrs))) + (cond ((eq (caar part-attrs) 'year) + (list year-part attrs-wo-year)) + ((eq (caar (last part-attrs)) 'year) + (list attrs-wo-year year-part)) + (t (list attrs-wo-year))))) + (t (--map (if (eq (car it) 'day) (list it) it) + part-attrs)))) + (rendered-range (citeproc-date--render-range-parts d1 d2 range-p-attrs range-sep + context))) + (citeproc-rt-join-formatted attrs rendered-range context)))) + +(defun citeproc-date--attrs-gran (d-attrs) + "Return the granularity (smallest unit) of date-attrs alist D-ATTRS. +The returned value is 0, 1 or 2, corresponding to a year, month +or day granularity." + (cond ((assoc 'day d-attrs) 2) + ((assoc 'month d-attrs) 1) + (t 0))) + +(defun citeproc-date--gran (date) + "Return the granularity (smallest unit) in citeproc-date struct DATE. +The returned value is 0, 1 or 2, corresponding to a year, month +or day granularity." + (cond ((citeproc-date-day date) 2) + ((citeproc-date-month date) 1) + (t 0))) + +(defun citeproc-date--render-year (d attrs context) + "Render the year in date D according to formatting in ATTRS. +D is a citeproc-date structure. Return a rich-text content." + (-let* ((form (alist-get 'form attrs)) + (year (citeproc-date-year d)) + (s (number-to-string (abs year))) + (era + (cond ((> year 999) "") + ((> year 0) (citeproc-term-get-text "ad" context)) + (t (citeproc-term-get-text "bc" context))))) + + (citeproc-rt-format-single attrs (concat (if (string= form "short") + (s-right 2 s) + s) + era) + context))) + +(defun citeproc-date--render-month (d attrs context) + "Render the month in date D according to formatting in ATTRS. +D is a citeproc-date structure. Return a rich-text content." + (-if-let (month (citeproc-date-month d)) + (let ((form (alist-get 'form attrs)) + (term-pref (if (citeproc-date-season d) + "season-" "month-"))) + (citeproc-rt-format-single + attrs + (pcase (citeproc-lib-intern form) + ('numeric (number-to-string month)) + ('numeric-leading-zeros (format "%02d" month)) + ('short (citeproc-term-inflected-text + (concat term-pref (format "%02d" month)) + 'short nil context)) + (_ (citeproc-term-inflected-text + (concat term-pref (format "%02d" month)) + 'long nil context))) + context)) + nil)) + +(defun citeproc-date--render-day (d attrs context) + "Render the day in date D according to formatting in ATTRS. +D is a citeproc-date structure. Return a rich-text content." + (-if-let (day (citeproc-date-day d)) + (let ((form (alist-get 'form attrs)) + (month (citeproc-date-month d))) + (citeproc-rt-format-single + attrs + (cond + ((string= form "numeric-leading-zeros") + (format "%02d" day)) + ((and (string= form "ordinal") + (or (= day 1) + (not (string= "true" + (alist-get 'limit-day-ordinals-to-day-1 + (citeproc-context-locale-opts context)))))) + (citeproc-number--format-as-ordinal (number-to-string day) + (concat "month-" (format "%02d" month)) + context)) + (t (number-to-string day))) + context)) + nil)) + +(provide 'citeproc-date) + +;;; citeproc-date.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-disamb.el b/elpa/citeproc-20240722.1110/citeproc-disamb.el new file mode 100644 index 00000000..0f585105 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-disamb.el @@ -0,0 +1,247 @@ +;;; citeproc-disamb.el --- disambiguate ambiguous cites -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to disambiguate cites of different bibliography items that would +;; have the same rendering. Disambiguation steps (e.g., adding more names, +;; expanding names, adding year-suffixes) are performed according to the +;; disambiguation rules specified by the CSL style in use. + +;;; Code: + +(require 'dash) +(require 'cl-lib) +(require 'subr-x) + +(require 'citeproc-itemdata) + +(defun citeproc-itd-inc-disamb-level (key itd type) + "Increment the disambiguation level of KEY in itemdata ITD. +TYPE is either `add-names' or `show-given-names.'" + (let ((vv (citeproc-itemdata-varvals itd))) + (if (alist-get type vv) + (let* ((cur-level (alist-get key (alist-get type vv))) + (new-level (if cur-level (1+ cur-level) 1))) + (setf (alist-get key (alist-get type vv)) new-level)) + (push `(,type . ((,key . 1))) (citeproc-itemdata-varvals itd)))) + (setf (citeproc-itemdata-rc-uptodate itd) nil)) + +(defun citeproc-itd-add-name (itd style &optional _first-step) + "Perform an add-name disambig. step on itemdata ITD with STYLE. +FIRST-STEP is ignored -- it is there to get the same signature as +the other two disamb. step functions. Return nil if no disambiguation +could be performed and t otherwise. Disambiguation is performed +from left to right: an item is attempted to be expanded only if +no previous items to the left could be." + (let* ((vars (citeproc-itd-namevars itd style)) + (cite (citeproc-itd-plain-cite itd style)) + (vv (citeproc-itemdata-varvals itd)) + (levels (alist-get 'add-names vv)) + (remaining-vars (if levels (memq (caar levels) vars) vars)) + (success nil)) + (while (and (not success) remaining-vars) + (citeproc-itd-inc-disamb-level (car remaining-vars) itd 'add-names) + (if (string= cite (citeproc-itd-plain-cite itd style)) + (pop remaining-vars) + (setq success t))) + success)) + +(defun citeproc-itd-add-given (itd style &optional first-step) + "Perform an add-given disambig. step on itemdata ITD with STYLE. +Unless FIRST-STEP is non-nil, remove the last previously added +given name if the last added given name is shown in its entirety. +Return nil if no disambig. step could be performed and t +otherwise." + (let* ((nids (citeproc-itd-nameids itd style)) + (cite (citeproc-itd-plain-cite itd style)) + (vv (citeproc-itemdata-varvals itd)) + (levels (alist-get 'show-given-names vv)) + (remaining-nids (if levels (memq (caar levels) nids) nids)) + (success nil)) + (while (and (not success) remaining-nids) + (let* ((current-nid (car remaining-nids)) + (vv (citeproc-itemdata-varvals itd)) + (levels (alist-get 'show-given-names vv)) + (current-level (alist-get current-nid levels))) + (if (and current-level (>= current-level 2)) + (pop remaining-nids) + (citeproc-itd-inc-disamb-level current-nid itd 'show-given-names) + (unless (string= cite (citeproc-itd-plain-cite itd style)) + (setq success t) + (unless (or first-step current-level) + (let ((ls (alist-get 'show-given-names vv))) + (setf (alist-get 'show-given-names vv) + (cons (car ls) (cddr ls)))) + (setf (citeproc-itemdata-rc-uptodate itd) nil)))))) + success)) + +(defun citeproc-itd-addgiven-with-addname (itd style &optional first-step) + "Perform a combined disambig. step on itemdata ITD with STYLE. +If FIRST-STEP is non-nil then (i) add a new name even if the last +add-given step showed only initials, (ii) don't remove the +previously added given name. Return nil if no disambig. step +could be performed and t otherwise." + (let* ((vv (citeproc-itemdata-varvals itd)) + (gn (alist-get 'show-given-names vv)) + (success nil) + (remaining-names t)) + (if (and (not first-step) gn (= 1 (cdar gn)) (citeproc-itd-add-given itd style)) + t + (while (and (not success) remaining-names) + (let ((nids (citeproc-itd-nameids itd style))) + (if (citeproc-itd-add-name itd style) + (let* ((new-nids (citeproc-itd-nameids itd style)) + (new-nid (car (cl-set-difference new-nids nids)))) + ;;next sexp is to direct the add-given function to the just added name + (when first-step + (setf (alist-get new-nid + (alist-get 'show-given-names + (citeproc-itemdata-varvals itd))) + 0)) + (when (citeproc-itd-add-given itd style first-step) + (setq success t))) + (setq remaining-names nil)))) + success))) + +(defun citeproc-disamb--different-cites-p (itds style) + "Whether some itemdata in ITDS have different cites with STYLE." + (--any-p (not (string= (citeproc-itd-plain-cite it style) + (citeproc-itd-plain-cite (car itds) style))) + (cdr itds))) + +(defun citeproc-disamb--with-method (itds style disamb-fun) + "Disambiguate itemdatas in ITDS for STYLE with DISAMB-FUN. +Return t if the disambiguation was (at least partially) +successful and nil otherwise." + (let ((orig-settings (copy-tree (citeproc-disamb--settings itds))) + success + (first-step t)) + (while (and (not success) + (--all-p (funcall disamb-fun it style first-step) itds)) + (setq first-step nil) + (when (citeproc-disamb--different-cites-p itds style) + (setq success t))) + (unless success + (citeproc-disamb--restore-settings itds orig-settings)) + success)) + +(defun citeproc-disamb--settings (itds) + "Return a list with the disamb settings of ITDS." + (--map (cons (citeproc-itd-getvar it 'add-names) + (citeproc-itd-getvar it 'show-given-names)) + itds)) + +(defun citeproc-disamb--restore-settings (itds settings) + "Restore the disamb settings of ITDS from SETTINGS. +SETTINGS should have the structure produced by citeproc--disamb-settings." + (cl-loop for itd in itds + for (add-names-val . show-given-val) in settings do + (citeproc-itd-setvar itd 'add-names add-names-val) + (citeproc-itd-setvar itd 'show-given-names show-given-val))) + +(defun citeproc-disamb--num-to-yearsuffix (n) + "Return year-suffix no. N (starting from 0)." + (cond ((< n 26) + (char-to-string (+ 97 n))) + ((< n 702) + (let* ((rem (% n 26)) + (d (/ (- n rem) 26))) + (concat (char-to-string (+ 96 d)) + (char-to-string (+ 97 rem))))) + (t (error "Number too large to convert into a year-suffix")))) + +(defun citeproc-disamb--add-yearsuffix (itds _style) + "Disambiguate itemdata in ITDS by adding year suffices. +Return t (for the sake of consistency with other disamb methods)." + (--each-indexed (--sort (< (string-to-number (citeproc-itd-getvar it 'citation-number)) + (string-to-number (citeproc-itd-getvar other 'citation-number))) + itds) + (citeproc-itd-setvar it 'year-suffix (citeproc-disamb--num-to-yearsuffix it-index)) + (setf (citeproc-itemdata-rc-uptodate it) nil)) + t) + +(defun citeproc-disamb--set-fields (itds) + "Disambiguate ITDS by setting their disambiguate fields." + (--each itds + (citeproc-itd-setvar it 'disambiguate t))) + +(defun citeproc-disamb-amb-itds (itds style name given yearsuff) + "Disambiguate ITDS ambigous for STYLE with the given methods. +NAME, GIVEN and YEARSUFF are generalized booleans specifying +whether or not the add-name, show-given or add-year-suffix +disambiguation methods should be used. Return t if the +disambiguation was (at least partially) successful, nil +otherwise." + (or (and name (citeproc-disamb--with-method itds style 'citeproc-itd-add-name)) + (and given (citeproc-disamb--with-method itds style 'citeproc-itd-add-given)) + (and name given + (citeproc-disamb--with-method itds style 'citeproc-itd-addgiven-with-addname)) + (progn + (citeproc-disamb--set-fields itds) + (citeproc-disamb--different-cites-p itds style)) + (and yearsuff + (citeproc-disamb--add-yearsuffix itds style) + (citeproc-disamb--different-cites-p itds style)))) + +(defun citeproc-amb-itds (itds style) + "Return a list of ambigous sets in ITDS for STYLE. +The returned value is a (possibly empty) list of lists." + (let* ((sorted (-sort (lambda (x y) + (string< (citeproc-itd-plain-cite x style) + (citeproc-itd-plain-cite y style))) + itds)) + (result nil) + (remaining (cdr sorted)) + (act (car sorted)) + (act-list (list act)) + (ambig nil)) + (while remaining + (let ((next (car remaining))) + (if (string= (citeproc-itd-plain-cite act style) + (citeproc-itd-plain-cite next style)) + (progn + (push next act-list) + (setq ambig t)) + (when ambig (push act-list result)) + (setq act-list (list next) + act next + ambig nil)) + (pop remaining))) + (when ambig (push act-list result)) + result)) + +(defun citeproc-disamb-itds (itds style name given yearsuff) + "Disambiguate itemdatas in list ITDS for STYLE. +NAME, GIVEN and YEARSUFF are generalized booleans specifying +whether or not the add-name, show-given or add-year-suffix +disambiguation methods should be used." + (let ((amb-itds (citeproc-amb-itds itds style))) + (while amb-itds + (let ((act-set (pop amb-itds))) + (citeproc-disamb-amb-itds act-set style name given yearsuff) + (when (citeproc-disamb--different-cites-p act-set style) + (-when-let (new-ambs (citeproc-amb-itds act-set style)) + (setq amb-itds (nconc new-ambs amb-itds)))))))) + +(provide 'citeproc-disamb) + +;;; citeproc-disamb.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-formatters.el b/elpa/citeproc-20240722.1110/citeproc-formatters.el new file mode 100644 index 00000000..6168a753 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-formatters.el @@ -0,0 +1,405 @@ +;; citeproc-formatters.el --- output formatters -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Provides a general framework for defining citeproc-el output formatters, and, +;; using this framework, defines formatters for the formats `raw' (the rich-text +;; internal representation), `plain' (plain-text), `html', `org' and `latex'. +;; Further output formatters can easily be added. + +;;; Code: + +(require 'let-alist) +(require 'subr-x) +(require 's) +(require 'cl-lib) + +(require 'citeproc-s) +(require 'citeproc-rt) + +(cl-defstruct (citeproc-formatter (:constructor citeproc-formatter-create)) + "Output formatter struct with slots RT, CITE, BIB-ITEM and BIB. +RT is a one-argument function mapping a rich-text to its + formatted version, +CITE is a one-argument function mapping the output of RT for a + citation rich-text to a fully formatted citation, +BIB-ITEM is a two-argument function mapping the output of RT for + a bibliography-item rich-text and a BIB-FORMAT alist (see + below) to a fully formatted bibliography item, +BIB is a two-argument function mapping a list of formatted + bibliography items and a FORMATTING-PARAMETERS alist (see + `citeproc-render-bib' for details) to a fully formatted + bibliography, +NO-EXTERNAL-LINKS is non-nil if the formatter doesn't support + external linking." + rt (cite #'identity) (bib-item (lambda (x _) x)) + (bib (lambda (x _) (mapconcat #'identity x "\n\n"))) + (no-external-links nil)) + +(defun citeproc-formatter-fun-create (fmt-alist) + "Return a rich-text formatter function based on FMT-ALIST. +FMT-ALIST is an alist with some or all of the following symbols +as keys: +- `unformatted', +- `font-style-italic', `font-style-oblique', `font-style-normal', +- `font-variant-small-caps', `font-variant-normal', +- `font-weight-bold', `font-weight-light', `font-weight-normal', +- `text-decoration-underline', `text-decoration-normal', +- `vertical-align-sub', `vertical-align-sup', `vertical-align-baseline', +- `display-block', `display-left-margin', `display-right-inline', + `display-indent', +- `href', +- `cited-item-no', `bib-item-no'. + +With the exceptions listed below the values should be +one-argument formatting functions that format the input string +according to the attribute-value pair specified by the key. + +The exceptions are the keys +`unformatted', for which the value should be a one-argument + function converting unformatted text into the required + format (e.g., by escaping); +`href', here the value should be a two-argument function + mapping the first argument as anchor text and the second as + target URI to a hyperlink representation; and +`cited-item-no' and `bib-item-no' whose associated values + should be two-argument functions, which are called with the + already formatted cites/bibliography item text and the number of + the bibliography item as a string." + (cl-labels + ((rt-fmt + (rt) + (pcase rt + ((pred stringp) (funcall (alist-get 'unformatted fmt-alist) rt)) + ((pred consp) + (let ((attrs (car rt)) + (result (mapconcat #'rt-fmt (cdr rt) ""))) + (dolist (attr attrs) + (let ((key (car attr))) + (if (memq key '(href cited-item-no bib-item-no)) + (when-let ((fmt-fun (alist-get key fmt-alist))) + (setq result (funcall fmt-fun result (cdr attr)))) + (when-let + ((fmt-fun + (alist-get + (pcase attr + ('(font-style . "italic") 'font-style-italic) + ('(font-weight . "bold") 'font-weight-bold) + ('(display . "indent") 'display-indent) + ('(display . "left-margin") 'display-left-margin) + ('(display . "right-inline") 'display-right-inline) + ('(display . "block") 'display-block) + ('(vertical-align . "sup") 'vertical-align-sup) + ('(vertical-align . "baseline") 'vertical-align-baseline) + ('(font-variant . "small-caps") 'font-variant-small-caps) + ('(text-decoration . "underline") 'text-decoration-underline) + ('(font-style . "oblique") 'font-style-oblique) + ('(font-style . "normal") 'font-style-normal) + ('(font-variant . "normal") 'font-variant-normal) + ('(font-weight . "light") 'font-weight-light) + ('(font-weight . "normal") 'font-weight-normal) + ('(text-decoration . "normal") 'text-decoration-normal) + ('(vertical-align . "sub") 'vertical-align-sub)) + fmt-alist))) + (setq result (funcall fmt-fun result)))))) + result)) + (_ rt)))) + #'rt-fmt)) + +;;;; Specific formatters + +;; Org + +(defun citeproc-fmt--org-link (anchor target) + "Return an Org link with ANCHOR and TARGET. +If ANCHOR is string= to TARGET then return ANCHOR." + (if (string= anchor target) + anchor + (concat "[[" target "][" anchor "]]"))) + +(defconst citeproc-fmt--org-alist + `((unformatted . identity) + (href . ,#'citeproc-fmt--org-link) + (cited-item-no . ,(lambda (x y) (concat "[[citeproc_bib_item_" y "][" x "]]"))) + (bib-item-no . ,(lambda (x y) (concat "<>" x))) + ;; Warning: The next four formatter lines put protective zero-width spaces + ;; around the Org format characters ('/' etc.). + (font-style-italic . ,(lambda (x) (concat "​/" x "/​"))) + (font-style-oblique . ,(lambda (x) (concat "​/" x "/​"))) + (font-weight-bold . ,(lambda (x) (concat "​*" x "*​"))) + (text-decoration-underline . ,(lambda (x) (concat "​_" x "_​"))) + ;; End of zero-width space protected formatters. + (font-variant-small-caps . ,(lambda (x) (upcase x))) + (vertical-align-sub . ,(lambda (x) (concat "_{" x "}"))) + (vertical-align-sup . ,(lambda (x) (concat "^{" x "}"))) + (display-left-margin . ,(lambda (x) (concat x " "))))) + +(defvar citeproc-fmt--org-format-rt-1 + (citeproc-formatter-fun-create citeproc-fmt--org-alist) + "Recursive rich-text Org formatter. +Doesn't do finalization by removing zero-width spaces.") + +(defun citeproc-fmt--org-format-rt (rt) + "Convert rich-text RT into Org format. +Performs finalization by removing unnecessary zero-width spaces." + (let ((result (funcall citeproc-fmt--org-format-rt-1 rt))) + (when (> (length result) 2) + ;; First we remove z-w spaces around spaces and before punctuation. + (setq result (citeproc-s-replace-all-seq + result '((" ​" . " ") ("​ " . " ") ("​," . ",") ("​;" . ";") + ("​:" . ":") ("​." . ".")))) + ;; Starting and ending z-w spaces are also removed, but not before an asterisk + ;; to avoid creating an Org heading. + (when (and (= (aref result 0) 8203) + (not (= (aref result 1) ?*))) + (setq result (substring result 1))) + (when (= (aref result (- (length result) 1)) 8203) + (setq result (substring result 0 -1))) + ;; Prepend a zero width no-break space when the text starts with + ;; superscript to make Org parse it correctly. + ;; NOTE: This is a workaround, ideally should be fixed in Org. + (when (= (aref result 0) ?^) + (setq result (concat "" result)))) + result)) + +;; HTML + +(defun citeproc-fmt--xml-escape (s) + "Return the xml-escaped version of string S. +Only '&', '<' and '>' are escaped to keep compatibility with the +CSL tests." + (citeproc-s-replace-all-seq s '(("&" . "&") ("<" . "<") (">" . ">")))) + +(defconst citeproc-fmt--html-alist + `((unformatted . citeproc-fmt--xml-escape) + (href . ,(lambda (x y) (concat "" x ""))) + (cited-item-no . ,(lambda (x y) (concat "" + x ""))) + (bib-item-no . ,(lambda (x y) (concat "" + x))) + (font-style-italic . ,(lambda (x) (concat "" x ""))) + (font-style-oblique . ,(lambda (x) + (concat ""))) + (font-variant-small-caps . ,(lambda (x) + (concat + "" x ""))) + (font-weight-bold . ,(lambda (x) (concat "" x ""))) + (text-decoration-underline . + ,(lambda (x) + (concat + "" x ""))) + (vertical-align-sub . ,(lambda (x) (concat "" x ""))) + (vertical-align-sup . ,(lambda (x) (concat "" x ""))) + (vertical-align-baseline . ,(lambda (x) (concat "" x ""))) + (display-left-margin . ,(lambda (x) (concat "\n
" + x "
"))) + (display-right-inline . ,(lambda (x) (concat "
" + x "
\n "))) + (display-block . ,(lambda (x) (concat "\n\n
" + x "
\n"))) + (display-indent . ,(lambda (x) (concat "
" x "
\n "))))) + +(defconst citeproc-fmt--csl-test-alist + `((unformatted . citeproc-fmt--xml-escape) + (cited-item-no . ,(lambda (x y) (concat "" + x ""))) + (bib-item-no . ,(lambda (x y) (concat "" + x))) + (font-style-italic . ,(lambda (x) (concat "" x ""))) + (font-style-oblique . ,(lambda (x) + (concat ""))) + (font-variant-small-caps . ,(lambda (x) + (concat + "" x ""))) + (font-weight-bold . ,(lambda (x) (concat "" x ""))) + (text-decoration-underline . + ,(lambda (x) + (concat + "" x ""))) + (vertical-align-sub . ,(lambda (x) (concat "" x ""))) + (vertical-align-sup . ,(lambda (x) (concat "" x ""))) + (vertical-align-baseline . ,(lambda (x) (concat "" x ""))) + (display-left-margin . ,(lambda (x) (concat "\n
" + x "
"))) + (display-right-inline . ,(lambda (x) (concat "
" + x "
\n "))) + (display-block . ,(lambda (x) (concat "\n\n
" + x "
\n"))) + (display-indent . ,(lambda (x) (concat "
" x "
\n "))))) + +(defun citeproc-fmt--html-bib-formatter (items _bib-format) + "Return a html bibliography from already formatted ITEMS." + (concat "
\n" + (mapconcat (lambda (i) + (concat "
" i "
\n")) + items + "") + "
")) + +;; LaTeX + +(defconst citeproc-fmt--latex-esc-regex + (regexp-opt '("_" "&" "#" "%" "$")) + "Regular expression matching characters to be escaped in LaTeX output.") + +(defun citeproc-fmt--latex-escape (s) + "Return the LaTeX-escaped version of string S." + (replace-regexp-in-string citeproc-fmt--latex-esc-regex "\\\\\\&" s)) + +(defconst citeproc-fmt--latex-uri-esc-regex + (regexp-opt '("#" "%")) + "Regular expression matching characters to be escaped in URIs for LaTeX output.") + +(defun citeproc-fmt--latex-href (text uri) + (let ((escaped-uri (replace-regexp-in-string + citeproc-fmt--latex-uri-esc-regex "\\\\\\&" uri))) + (if (string-prefix-p "http" text) + (concat "\\url{" escaped-uri "}") + (concat "\\href{" escaped-uri "}{" text "}")))) + +(defconst citeproc-fmt--latex-alist + `((unformatted . ,#'citeproc-fmt--latex-escape) + (href . ,#'citeproc-fmt--latex-href) + (font-style-italic . ,(lambda (x) (concat "\\textit{" x "}"))) + (font-weight-bold . ,(lambda (x) (concat "\\textbf{" x "}"))) + (cited-item-no . ,(lambda (x y) (concat "\\citeprocitem{" y "}{" x "}"))) + (bib-item-no . ,(lambda (x y) (concat "\\hypertarget{citeproc_bib_item_" y "}{" + x "}"))) + (font-variant-small-caps . ,(lambda (x) (concat "\\textsc{" x "}"))) + (text-decoration-underline . ,(lambda (x) (concat "\\underline{" x "}"))) + (vertical-align-sup . ,(lambda (x) (concat "\\textsuperscript{" x "}"))) + (display-left-margin . ,(lambda (x) (concat x " "))) + (vertical-align-sub . ,(lambda (x) (concat "\\textsubscript{" x "}"))) + (font-style-oblique . ,(lambda (x) (concat "\\textsl{" x "}"))))) + +;; Org-LaTeX + +(defconst citeproc-fmt--org-latex-alist + `((unformatted . ,#'citeproc-fmt--latex-escape) + (href . ,#'citeproc-fmt--latex-href) + (font-style-italic . ,(lambda (x) (concat "\\textit{" x "}"))) + (font-weight-bold . ,(lambda (x) (concat "\\textbf{" x "}"))) + (cited-item-no . ,(lambda (x y) (concat "\\cslcitation{" y "}{" x "}"))) + (bib-item-no . ,(lambda (x y) (concat "\\cslbibitem{" y "}{" x "}"))) + (font-variant-small-caps . ,(lambda (x) (concat "\\textsc{" x "}"))) + (text-decoration-underline . ,(lambda (x) (concat "\\underline{" x "}"))) + (vertical-align-sup . ,(lambda (x) (concat "\\textsuperscript{" x "}"))) + (display-left-margin . ,(lambda (x) (concat "\\cslleftmargin{" x "}"))) + (display-right-inline . ,(lambda (x) (concat "\\cslrightinline{" x "}"))) + (display-block . ,(lambda (x) (concat "\\cslblock{" x "}"))) + (display-indent . ,(lambda (x) (concat "\\cslindent{" x "}"))) + (vertical-align-sub . ,(lambda (x) (concat "\\textsubscript{" x "}"))) + (font-style-oblique . ,(lambda (x) (concat "\\textsl{" x "}"))))) + +(defun citeproc-fmt--org-latex-bib-formatter (items bib-format) + "Return an Org LaTeX bibliography of ITEMS formatted in BIB-FORMAT." + (let-alist bib-format + (let ((hanging-indent (if .hanging-indent "1" "0")) + (entry-spacing (if (and .entry-spacing (<= 1 .entry-spacing)) + (number-to-string (- .entry-spacing 1)) + "0"))) + (concat "\\begin{cslbibliography}{" hanging-indent "}{" entry-spacing "}\n" + (mapconcat #'identity items "\n\n") + "\n\n\\end{cslbibliography}\n")))) + +;; Org-ODT + +(defconst citeproc-fmt--org-odt-alist + `((unformatted . citeproc-fmt--xml-escape) + (href . ,(lambda (x y) (concat "" x ""))) + (cited-item-no + . ,(lambda (x y) (concat "" x ""))) + (bib-item-no + . ,(lambda (x y) + (concat "" + "" + "" x))) + (font-style-italic + . ,(lambda (x) (concat "" x ""))) + (font-style-oblique + . ,(lambda (x) (concat "" x ""))) + ;; NOTE: small caps support requires the availability of the OrgSmallcaps ODT style + ;; this requires an addition to or replacement of the default OrgOdtStyles.xml + (font-variant-small-caps + . ,(lambda (x) (concat "" x ""))) + (font-weight-bold + . ,(lambda (x) (concat "" x ""))) + (text-decoration-underline + . ,(lambda (x) (concat "" x ""))) + (vertical-align-sub + . ,(lambda (x) (concat "" x ""))) + (vertical-align-sup + . ,(lambda (x) + (concat "" x ""))) + ;; TODO: + ;; - display-left-margin + ;; - display-right-inline + ;; - display-block + ;; - display-indent + )) + +(defun citeproc-fmt--org-odt-bib-formatter (items _bib-format) + "Return a html bibliography from already formatted ITEMS." + (mapconcat (lambda (i) + (concat "" i "")) + items + "\n")) + +;; Define the formatters alist + +(defvar citeproc-fmt--formatters-alist + `((org-odt . ,(citeproc-formatter-create + :rt (citeproc-formatter-fun-create citeproc-fmt--org-odt-alist) + :bib #'citeproc-fmt--org-odt-bib-formatter + )) + (html . ,(citeproc-formatter-create + :rt (citeproc-formatter-fun-create citeproc-fmt--html-alist) + :bib #'citeproc-fmt--html-bib-formatter)) + (csl-test . ,(citeproc-formatter-create + :rt (citeproc-formatter-fun-create citeproc-fmt--csl-test-alist) + :bib #'citeproc-fmt--html-bib-formatter + :no-external-links t)) + (raw . ,(citeproc-formatter-create :rt #'identity :bib (lambda (x _) x))) + (org . ,(citeproc-formatter-create :rt #'citeproc-fmt--org-format-rt)) + (org-latex . ,(citeproc-formatter-create + :rt (citeproc-formatter-fun-create citeproc-fmt--org-latex-alist) + :bib #'citeproc-fmt--org-latex-bib-formatter)) + (latex . ,(citeproc-formatter-create + :rt (citeproc-formatter-fun-create citeproc-fmt--latex-alist) + :bib (lambda (x _) (concat (mapconcat #'identity x "\n\n") + "\\bigskip")))) + (plain . ,(citeproc-formatter-create :rt #'citeproc-rt-to-plain + :no-external-links t))) + "Alist mapping supported output formats to formatter structs.") + +(defun citeproc-formatter-for-format (format) + "Return the formatter struct belonging to FORMAT. +FORMAT is a symbol" + (if-let ((formatter (alist-get format citeproc-fmt--formatters-alist))) + formatter + (error "No formatter for citeproc format `%s'" format))) + +(provide 'citeproc-formatters) + +;;; citeproc-formatters.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-generic-elements.el b/elpa/citeproc-20240722.1110/citeproc-generic-elements.el new file mode 100644 index 00000000..306a367e --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-generic-elements.el @@ -0,0 +1,151 @@ +;;; citeproc-generic-elements.el --- render generic CSL elements -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions corresponding to the generic CSL rendering elements cs:layout, +;; cs:group and cs:text. With the exception of `citeproc--layout' they return a +;; (CONTENT . CONTENT-TYPE) pair, where CONTENT is the rendered rich-text output +;; and CONTENT-TYPE is one of the symbols `text-only', `empty-vars' and +;; `present-var.' In contrast, `citeproc--layout' returns only the rendered +;; rich-text content. + +;;; Code: + +(require 'dash) +(require 'let-alist) +(require 's) + +(require 'citeproc-rt) +(require 'citeproc-context) +(require 'citeproc-macro) + +(defun citeproc--layout (attrs context &rest body) + "Render the content of a layout element with ATTRS and BODY." + (let* ((attrs (if (eq (citeproc-context-mode context) 'bib) attrs + nil)) ; No attrs if mode is cite -- they are used for citations + (spliced-body (citeproc-lib-splice-into body 'splice)) + (suffix (alist-get 'suffix attrs)) + (attrs-wo-suffix (--remove (eq (car it) 'suffix) attrs)) + (rendered-body (--map (car it) spliced-body))) + ;; Handle second-field align + (when (and (alist-get 'second-field-align (citeproc-context-opts context)) + (> (length rendered-body) 1)) + (setq rendered-body `((((display . "left-margin")) ,(car rendered-body)) + (((display . "right-inline")) ,@(cdr rendered-body))))) + (let* ((affix-rendered (citeproc-rt-render-affixes + (citeproc-rt-dedup (citeproc-rt-join-formatted attrs-wo-suffix rendered-body + context)))) + (last-elt (and (listp affix-rendered) (-last-item affix-rendered))) + (last-display (and (consp last-elt) (car last-elt) + (--any-p (eq (car it) 'display) (car last-elt))))) + (when suffix + (if last-display + ;; If the last element has a display attribute then we have to append the + ;; suffix string to this last element + (setf (nth (1- (length affix-rendered)) affix-rendered) + (-snoc (-last-item affix-rendered) suffix)) + ;; Else we simply append it to the already rendered content + (setq affix-rendered (if (listp affix-rendered) + (-snoc affix-rendered suffix) + (concat affix-rendered suffix))))) + affix-rendered))) + +(defun citeproc--group (attrs context &rest body) + "Render the content of a group element with ATTRS and BODY." + (-let* ((spliced-body (citeproc-lib-splice-into body 'splice)) + (types (--map (cdr it) spliced-body)) + (type (cond ((--all? (eq it 'text-only) types) + 'text-only) + ((--any? (eq it 'present-var) types) + 'present-var) + (t 'empty-vars)))) + (cons (if (or (eq type 'text-only) + (eq type 'present-var)) + (citeproc-rt-join-formatted attrs (--map (car it) spliced-body) context) + nil) + type))) + +(defconst citeproc-generic-elements--url-prefix-re "https?://\\S *\\'" + "Regex matching an URL prefix at the end of a string.") + +(defun citeproc--text (attrs context &rest _body) + "Render the content of a text element with ATTRS and BODY." + (let-alist attrs + (let ((content nil) + (type 'text-only) + (no-external-links (citeproc-context-no-external-links context))) + (cond (.value (setq content .value)) + (.variable + (let ((val (citeproc-var-value (intern .variable) context (citeproc-lib-intern + .form)))) + (setq content val) + (cond + (val (let ((var (intern .variable))) + (setq type 'present-var) + (push `(rendered-var . ,var) attrs) + (when (and (not no-external-links) + (memq var citeproc--linked-vars)) + (let ((target + (concat + (alist-get var citeproc--link-prefix-alist + "") + content))) + (-when-let (match-pos + (and .prefix (s-matched-positions-all + citeproc-generic-elements--url-prefix-re + .prefix))) + ;; If the prefix ends with an URL then it is moved + ;; from the prefix to the rendered variable + ;; content. + (let ((start (caar match-pos))) + (setq content (concat (substring .prefix start) content)) + (push (cons 'prefix (substring .prefix 0 start)) + attrs))) + (push (cons 'href target) attrs))))) + ;; Don't report empty var for year-suffix, see issue #70. + ((not (string= .variable "year-suffix")) (setq type 'empty-vars))))) + (.term (setq .form (if .form (intern .form) 'long) + .plural (if (or (not .plural) + (string= .plural "false")) + 'single 'multiple) + content (let ((cont (citeproc-term-inflected-text + .term .form .plural context))) + ;; Annotate the 'no date' term as if it'd be + ;; the value of the 'issue' variable to + ;; handle implicit year suffix addition and + ;; suppression issues. + (if (string= .term "no date") + (progn + (setq type 'present-var) + `(((rendered-var . issued)) ,cont)) + cont)))) + (.macro (let ((macro-val (citeproc-macro-output .macro context))) + (setq content (car macro-val)) + (setq type (cdr macro-val))))) + ;; We stop if only the title had to be rendered. + (let ((result (cons (citeproc-rt-format-single attrs content context) type))) + (citeproc-context-maybe-stop-rendering + 'title context result (or (and .variable (intern .variable)) t)))))) + +(provide 'citeproc-generic-elements) + +;;; citeproc-generic-elements.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-itemdata.el b/elpa/citeproc-20240722.1110/citeproc-itemdata.el new file mode 100644 index 00000000..bbb62f7f --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-itemdata.el @@ -0,0 +1,102 @@ +;;; citeproc-itemdata.el --- represent and access bibliography items -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Structure type and functions to handle data about bibliography items. + +;;; Code: + +(require 'citeproc-rt) +(require 'citeproc-context) + +(cl-defstruct (citeproc-itemdata (:constructor citeproc-itemdata-create)) + "Struct for storing bibliography item data. +VARVALS is an alist containg variable-name symbols as keys and + their values for the item as values, +RAWCITE is the cached cite of the item in internal rich-text + format, +RC-UPTODATE is t iff the RAWCITE field is up-to-date, +RAWBIBITEM is the cached bibliograhy item in internal rich-text + format. +SORT-KEY is the bibliography sort-key of the item, +OCCURRED-BEFORE is used during bibliography generation to + indicate whether the item was referred to earlier. If the first + occurrence is in a note then the actual value is the + note-number, +DISAMB-POS contains the position on which cite disambiguation is + based. Possible values are 'first, 'ibid and 'subsequent, +SUBBIB-NOS is a list of numeric indexes of sub-bibliographies + in which the item occurs, +UNCITED is t iff the item has no associated citation." + varvals rawcite rawbibitem rc-uptodate sort-key occurred-before + disamb-pos subbib-nos uncited) + +(defun citeproc-itd-getvar (itd var) + "Return itemdata ITD's value for VAR ." + (alist-get var (citeproc-itemdata-varvals itd))) + +(defun citeproc-itd-setvar (itd var val) + "Set itemdata ITD's value for VAR to VAL." + (setf (alist-get var (citeproc-itemdata-varvals itd) nil t) val + (citeproc-itemdata-rc-uptodate itd) nil)) + +(defun citeproc-itd-rt-cite (itd style) + "Return the rich-text cite of itemdata ITD using STYLE." + (if (citeproc-itemdata-rc-uptodate itd) + (citeproc-itemdata-rawcite itd) + (let ((rc (citeproc-render-varlist-in-rt + (cons (cons 'position (citeproc-itemdata-disamb-pos itd)) + (citeproc-itemdata-varvals itd)) + style + 'cite 'display 'no-links t))) + (setf (citeproc-itemdata-rawcite itd) rc + (citeproc-itemdata-rc-uptodate itd) t) + rc))) + +(defun citeproc-itd-plain-cite (itd style) + "Return the plain text cite of itemdata ITD using STYLE." + (citeproc-rt-to-plain (citeproc-itd-rt-cite itd style))) + +(defun citeproc-itd-namevars (itd style) + "Rendered namevars in the cite of itemdata ITD using STYLE." + (citeproc-rt-rendered-name-vars (citeproc-itd-rt-cite itd style))) + +(defun citeproc-itd-nameids (itd style) + "Rendered name ids in the cite of itemdata ITD using STYLE." + (citeproc-rt-rendered-name-ids (citeproc-itd-rt-cite itd style))) + +(defun citeproc-itd-update-disamb-pos (itd pos) + "Update the highest position of ITD with position POS." + (let ((old (citeproc-itemdata-disamb-pos itd))) + (unless (eq old 'subsequent) + (let ((new (pcase pos + ('first 'first) + ((or 'ibid 'ibid-with-locator) 'ibid) + (_ 'subsequent)))) + (setf (citeproc-itemdata-disamb-pos itd) + (cond ((memq old '(nil first)) new) + ((eq new 'subsequent) 'subsequent) + (t 'ibid))))))) + +(provide 'citeproc-itemdata) + +;;; citeproc-itemdata.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-itemgetters.el b/elpa/citeproc-20240722.1110/citeproc-itemgetters.el new file mode 100644 index 00000000..0d0a618e --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-itemgetters.el @@ -0,0 +1,188 @@ +;; citeproc-itemgetters.el --- functions for constructing itemgetters -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions for constructing various types of bibliographic itemgetter +;; functions. The returned itemgetter functions can, in turn, be used to create +;; `citeproc-style' and `citeproc-proc' structures. + +;;; Code: + +(require 'dash) +(require 'org) +;; Handle the fact that org-bibtex has been renamed to ol-bibtex -- for the time +;; being we support both feature names. +(or (require 'ol-bibtex nil t) + (require 'org-bibtex)) +(require 'json) +(require 'bibtex) +(require 'parsebib) + +(require 'citeproc-bibtex) +(require 'citeproc-biblatex) + +(defun citeproc-itemgetters--parsebib-buffer (entries strings) + "Parse a BibTeX/biblatex buffer with Parsebib." + ;; Note: this is needed to support different Parsebib versions in use. + (cond ((fboundp 'parsebib-parse-buffer) + (parsebib-parse-buffer entries strings t t)) + ((fboundp 'parsebib-parse-bib-buffer) + (parsebib-parse-bib-buffer :entries entries :strings strings + :expand-strings t :inheritance t)) + (t (error "No Parsebib buffer parsing function is available")))) + +(defun citeproc-hash-itemgetter-from-csl-json (file) + "Return a hash-based getter for csl json bibliography FILE." + (let* ((json-array-type 'list) + (json-key-type 'symbol) + (item-list (json-read-file file)) + (hash (make-hash-table :test 'equal))) + (--each item-list + (puthash (alist-get 'id it) it hash)) + (lambda (itemids) (--map (cons it (gethash it hash)) + itemids)))) + +(defun citeproc-itemgetter-from-csl-json (file) + "Return an item-getter for csl json bibliography FILE." + (lambda (itemids) + (let* ((json-array-type 'list) + (json-key-type 'symbol) + (item-list (json-read-file file)) + result) + (dolist (item item-list result) + (let ((id (alist-get 'id item))) + (when (member id itemids) + (push (cons id item) result))))))) + +(defun citeproc-itemgetter-from-bibtex (file-or-files) + "Return a getter for BibTeX bibliography FILE-OR-FILES." + (if (listp file-or-files) + (lambda (itemids) + (let (result + (remaining-ids (cl-copy-list itemids)) + (remaining-files file-or-files)) + (while (and remaining-ids remaining-files) + (let ((file (pop remaining-files))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (bibtex-set-dialect 'BibTeX t) + (bibtex-map-entries + (lambda (key _beg _end) + (when (member key itemids) + (push (cons key (citeproc-bt-entry-to-csl (bibtex-parse-entry))) + result) + (setq remaining-ids (delete key remaining-ids)))))))) + result)) + (lambda (itemids) + (let (result) + (with-temp-buffer + (insert-file-contents file-or-files) + (goto-char (point-min)) + (bibtex-set-dialect 'BibTeX t) + (bibtex-map-entries + (lambda (key _beg _end) + (when (member key itemids) + (push (cons key (citeproc-bt-entry-to-csl (bibtex-parse-entry))) + result))))) + result)))) + +(defun citeproc-itemgetter-from-org-bibtex (file-or-files) + "Return a getter for org-bibtex bibliography FILE-OR-FILES." + (let ((files (if (listp file-or-files) + file-or-files + (list file-or-files)))) + (lambda (itemids) + (let (result) + (org-map-entries + (lambda () + (-when-let (key-w-entry (citeproc-bt-from-org-headline itemids)) + (push (cons (car key-w-entry) + (citeproc-bt-entry-to-csl (cdr key-w-entry))) + result))) + t files) + result)))) + +(defun citeproc-hash-itemgetter-from-any (file-or-files &optional no-sentcase-wo-langid) + "Return a getter for FILE-OR-FILES in any supported format. +The format is determined on the basis of file extensions. +Supported formats: +- CSL-JSON (.json extension) the recommended native format; +- BibTeX/biblatex (.bib or .bibtex extension), +- org-bibtex (.org extension). +If NO-SENTCASE-WO-LANGID is non-nil then title fields in items +without a `langid' field are not converted to sentence-case." + (let ((files (if (listp file-or-files) + file-or-files + (list file-or-files))) + (cache (make-hash-table :test #'equal)) + (bt-entries (make-hash-table :test #'equal)) + (bt-strings (make-hash-table :test #'equal))) + (dolist (file files) + (pcase (file-name-extension file) + ("json" + (let ((json-array-type 'list) + (json-key-type 'symbol)) + (dolist (item (json-read-file file)) + (puthash (cdr (assq 'id item)) item cache)))) + ((and (or "bib" "bibtex") ext) + (with-temp-buffer + (insert-file-contents file) + (bibtex-set-dialect (if (string= ext "bib") 'biblatex 'BibTeX) t) + (citeproc-itemgetters--parsebib-buffer bt-entries bt-strings))) + ("org" + (org-map-entries + (lambda () + (-when-let (key-w-entry (citeproc-bt-from-org-headline)) + (condition-case err + (puthash (car key-w-entry) (citeproc-blt-entry-to-csl + (cdr key-w-entry)) + cache) + (error + (user-error + "Couldn't parse the bib(la)tex entry with key '%s', the error was: %s" + (car key-w-entry) err))))) + t (list file))) + (ext + (user-error "Unknown bibliography extension: %S" ext)))) + (maphash + (lambda (key entry) + (condition-case err + (puthash key (citeproc-blt-entry-to-csl entry nil no-sentcase-wo-langid) + cache) + (error + (user-error + "Couldn't parse the bib(la)tex entry with key '%s', the error was: %s" + key err)))) + bt-entries) + (lambda (x) + (pcase x + ('itemids + (hash-table-keys cache)) + ((pred listp) (mapcar (lambda (id) + (cons id (gethash id cache))) + x)) + (_ (error "Unsupported citeproc itemgetter retrieval method")))))) + +(provide 'citeproc-itemgetters) + +;;; citeproc-itemgetters.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-lib.el b/elpa/citeproc-20240722.1110/citeproc-lib.el new file mode 100644 index 00000000..004524e8 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-lib.el @@ -0,0 +1,150 @@ +;;; citeproc-lib.el --- misc functions and variables for citeproc-el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; General utility functions used in citeproc-el. + +;;; Code: + +(require 'dash) +(require 's) + +(defconst citeproc--number-vars + '(chapter-number citation-number collection-number edition first-reference-note-number + issue number number-of-pages number-of-volumes page page-first + part-number printing-number section supplement-number version volume) + "CSL number variables." + ;; Note: `locator', which is also on the official list, is omitted because + ;; it's treated specially in the code. + ) + +(defconst citeproc--date-vars + '(accessed available-date event-date issued original-date submitted locator-date) + "CSL date variables.") + +(defconst citeproc--name-vars + '(author chair collection-editor compiler composer container-author contributor + curator director editor editorial-director editor-translator executive-producer + guest host illustrator interviewer narrator organizer original-author + performer producer recipient reviewed-author script-writer series-creator + translator) + "CSL name variables.") + +(defconst citeproc--linked-vars + '(DOI PMCID PMID URL) + "Variables whose rendered content should be linked. +The ordering is according to priority ") + +(defconst citeproc--link-prefix-alist + '((DOI . "https://doi.org/") + (PMID . "https://www.ncbi.nlm.nih.gov/pubmed/") + (PMCID . "https://www.ncbi.nlm.nih.gov/pmc/articles/")) + "Alist mapping variable names to uri prefixes.") + +(defun citeproc-lib-parse-xml-file (file) + "Return the parsed xml representation of FILE." + (with-temp-buffer + (insert-file-contents file) + (libxml-parse-xml-region (point-min) (point-max)))) + +(defun citeproc-lib-remove-xml-comments (tree) + "Remove comments from xml TREE." + (let ((head (car tree)) + (attrs (cadr tree)) + (body (cddr tree)) + result) + (while body + (pcase (car body) + ((pred atom) (push (pop body) result)) + (`(comment . ,_) (pop body)) + (_ (push (citeproc-lib-remove-xml-comments (pop body)) result)))) + (let ((full-result (cons head (cons attrs (nreverse result))))) + ;; Handle the problem of the top element added by the libxml parser when + ;; there is a comment after the xml declaration. + (if (eq (car full-result) 'top) + (caddr full-result) + full-result)))) + +(defun citeproc-lib-parse-html-frag (s) + "Return the parsed representation of html in string S." + (with-temp-buffer + (insert s) + (libxml-parse-html-region (point-min) (point-max)))) + +(defun citeproc-lib-intern (s) + "Intern S if it is a string, return nil if it is nil." + (cond ((not s) nil) + ((stringp s) (intern s)) + (t (error "Function citeproc-lib-intern was called with an argument that is neither string nor nil")))) + +(defun citeproc-lib-named-parts-to-alist (e) + "Collect the attrs of parsed xml element E's enclosed elements. +The attributes are collected into an alist consisting +of (PARTNAME . ATTRS) pairs, where PARTNAME is the value of the +enclosed element's `name' attr" + (--map (cons (intern (alist-get 'name it)) + (assq-delete-all 'name it)) + (mapcar #'cadr (-remove #'stringp (cddr e))))) + +(defun citeproc-lib-lex-compare (l1 l2 cmp-fun sort-orders) + "Whether list L1 lexicographically precedes list L2. +CMP-FUN is a three-valued (1, 0, -1) comparator function, +SORT-ORDERS is a list of sort orders (see the bib- and +cite-sort-orders slots of `citeproc-style' for details). Return t +iff L1 is strictly ordered before L2, nil otherwise." + (unless sort-orders + (setq sort-orders (make-list (length l1) t))) + (let (result) + (while (and l1 (not result)) + (let ((comp + (funcall cmp-fun (pop l1) (pop l2) (not (pop sort-orders))))) + (unless (= comp 0) + (setq result comp)))) + (equal result 1))) + +(defun citeproc-lib-splice-into (list tag) + "Splice elements with car TAG into LIST." + (let (result) + (dolist (elt list) + (if (and (consp elt) (eq tag (car elt))) + (dolist (e (cdr elt)) + (push e result)) + (push elt result))) + (nreverse result))) + +(defun citeproc-lib-add-splice-tag (list tag) + "Add TAG as car if LIST is not a singleton. +Return the first element if LIST is singleton." + (if (cdr list) (cons tag list) (car list))) + +(defun citeproc-lib-numeric-p (val) + "Return whether VAL is numeric content. +VAL has numeric content if it is a number or a string containing +numeric content." + (or (numberp val) + (and (stringp val) + (s-matches-p "\\`[[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\(\\( *\\([,&-]\\|--\\) *\\)?[[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)?\\'" + val)))) + +(provide 'citeproc-lib) + +;;; citeproc-lib.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-locale.el b/elpa/citeproc-20240722.1110/citeproc-locale.el new file mode 100644 index 00000000..aee16912 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-locale.el @@ -0,0 +1,93 @@ +;; citeproc-locale.el --- CSL locale related functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2022 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; In addition to some locale handling helpers, this file provides the function +;; `citeproc-locale-getter-from-dir', which constructs locale getter functions +;; that retrieve locales from a given directory. + +;;; Code: + +(require 'dash) +(require 'f) +(require 's) + +(require 'citeproc-lib) +(require 'citeproc-term) + +(defconst citeproc-locale--default-variants-alist + '(("af" . "ZA") ("ca" . "AD") ("cs" . "CZ") ("cy" . "GB") + ("da" . "DK") ("en" . "US") ("el" . "GR") ("et" . "EE") + ("fa" . "IR") ("he" . "IR") ("ja" . "JP") ("km" . "KH") + ("ko" . "KR") ("nb" . "NO") ("nn" . "NO") ("sl" . "SI") + ("sr" . "RS") ("sv" . "SE") ("uk" . "UA") ("vi" . "VN") + ("zh" . "CN")) + "Alist mapping locales to their default variants. +Only those locales are given for which the default variant is not +simply the result of upcasing.") + +(defconst citeproc-locale--simple-locales + '("la" "eu" "ar") + "List of simple locale names (without dash).") + +(defun citeproc-locale--extend (loc) + "Extend simple locale LOC to default variant." + (let ((variant (assoc-default loc citeproc-locale--default-variants-alist))) + (concat loc "-" (or variant (s-upcase loc))))) + +(defun citeproc-locale--compatible-p (l1 l2) + "Whether locales L1 and L2 are compatible." + (or (not (and l1 l2)) + (s-prefix-p l1 l2) + (s-prefix-p l2 l1))) + +(defun citeproc-locale-getter-from-dir (dir) + "Return a locale getter getting parsed locales from a local DIR. +If the requested locale couldn't be read then return the parsed +en-US locale, which must exist." + (let ((default-loc-file (f-join dir "locales-en-US.xml"))) + (lambda (loc) + (let* ((ext-loc (if (or (member loc citeproc-locale--simple-locales) + (s-contains-p "-" loc)) + loc + (citeproc-locale--extend loc))) + (loc-file (concat dir "/locales-" ext-loc ".xml")) + (loc-available (f-readable-p loc-file))) + (citeproc-lib-remove-xml-comments + (citeproc-lib-parse-xml-file + (if loc-available loc-file + (if (not (f-readable-p default-loc-file)) + (error + "The default CSL locale file %s doesn't exist or is unreadable" + default-loc-file) + default-loc-file)))))))) + +(defun citeproc-locale-termlist-from-xml-frag (frag) + "Transform xml FRAG representing citeproc--terms into a citeproc-term list." + (--mapcat (if (eq 'term (car it)) + (citeproc-term--from-xml-frag (cdr it)) + nil) + frag)) + +(provide 'citeproc-locale) + +;;; citeproc-locale.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-macro.el b/elpa/citeproc-20240722.1110/citeproc-macro.el new file mode 100644 index 00000000..d4b6ddcd --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-macro.el @@ -0,0 +1,58 @@ +;; citeproc-macro.el --- functions to render CSL macros -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to render the output of CSL macros. + +;;; Code: + +(require 'citeproc-lib) +(require 'citeproc-rt) +(require 'citeproc-context) + +;;; For macro evaluation +(defun citeproc--macro (attrs context &rest body) + "Render the content of a macro element with ATTRS and BODY." + (let* ((spliced-body (citeproc-lib-splice-into body 'splice)) + (val (citeproc-rt-typed-join attrs spliced-body context))) + (if (eq 'empty-vars (cdr val)) + (cons nil 'text-only) + val))) + +(defun citeproc-macro-output (macro context) + "Return the output of MACRO. +MACRO is the macro's name as a string and the returned value is a +(RICH-TEXT-CONTENT . CONTENT-TYPE) cons cell." + (let ((macro-fun (assoc-default macro (citeproc-context-macros context)))) + (if macro-fun + (funcall macro-fun context) + (error "There is no macro called `%s' in style" macro)))) + +(defun citeproc-macro-output-as-text (macro context) + "Return the output of MACRO as plain text. +MACRO is the macro's name as a string." + (citeproc-rt-to-plain (citeproc-rt-render-affixes + (car (citeproc-macro-output macro context))))) + +(provide 'citeproc-macro) + +;;; citeproc-macro.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-name.el b/elpa/citeproc-20240722.1110/citeproc-name.el new file mode 100644 index 00000000..6825134b --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-name.el @@ -0,0 +1,452 @@ +;;; citeproc-name.el --- CSL name and label rendering -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to render CSL name and label elements. + +;;; Code: + +(require 'subr-x) +(require 'let-alist) +(require 'dash) +(require 's) + +(require 'citeproc-lib) +(require 'citeproc-s) +(require 'citeproc-rt) +(require 'citeproc-context) +(require 'citeproc-term) + +(defvar citeproc-name-postprocess-functions nil + "A list of functions to postprocess rendered names. +Each function takes three arguments: +- the rich-text rendering of a name to be post-processed, +- the rendered name as an alist with CSL name-part + keys (`family', `given' etc.), and +- the rendering context, as a `citeproc-context' structure. +The output of each function should be the post-processed +rich-text, and the functions are applied in the order they appear +in the list.") + +;; OPTIMIZE: Name count could be sped up by only counting the names to be +;; rendered without actually rendering them +(defun citeproc-name-render-vars + (varstring attrs name-attrs name-part-attrs et-al-attrs with-label + label-before-names label-attrs context) + "Render namevars contained in VARSTRING according to the given attrs. +VARSTRING is a string containing variable names separated by +spaces. Labels are also rendered (with formatting according to +LABEL-ATTRS) if WITH-LABEL is t." + (let* ((vars (-map 'intern (s-split " " varstring))) + (present-vars (--filter (citeproc-var-value it context) vars)) + ed-trans) + (when (and (memq 'editor present-vars) + (memq 'translator present-vars) + (= 2 (length present-vars)) + (equal (--map (alist-get 'name-id it) + (citeproc-var-value 'editor context)) + (--map (alist-get 'name-id it) + (citeproc-var-value 'translator context)))) + (setq present-vars '(editor) + ed-trans t)) + (unless (alist-get 'delimiter attrs) + (-when-let (names-delim (alist-get 'names-delimiter (citeproc-context-opts context))) + (push (cons 'delimiter names-delim) attrs))) + (if present-vars + (cons (citeproc-rt-join-formatted + attrs + (--map (citeproc-name--render-var it name-attrs name-part-attrs + et-al-attrs with-label + label-before-names + label-attrs + context + ed-trans) + present-vars) + context) + 'present-var) + (cons nil 'empty-vars)))) + +(defun citeproc-name--render-var (var attrs name-part-attrs et-al-attrs with-label + label-before-names + label-attrs context &optional ed-trans) + "Render the value of csl name variable VAR according to given attrs. +VAR is a symbol. + +Note: The label (if there is one) is prepended to the name(s) if +the form is verb and also when the label element was before the +names element in the style. The latter is not allowed in the +standard, so can be considered an extension. It's supported +because some styles rely on it, notably that of the journal +Nature." + ;; Push the current add-names offset for VAR to the ATTRS + (-when-let (add-names-alist (citeproc-var-value 'add-names context)) + (-when-let (add-names-val (alist-get var add-names-alist)) + (push `(add-names . ,add-names-val) attrs))) + (let* ((var-value (citeproc-var-value var context)) + (rendered-names (citeproc-name--render-names + var-value attrs et-al-attrs name-part-attrs + context))) + (when (atom rendered-names) (setq rendered-names (list nil rendered-names))) + (push (list 'rendered-names) (car rendered-names)) + (push `(variable . ,(if ed-trans "editortranslator" (symbol-name var))) + label-attrs) + (let ((plural-val (alist-get 'plural label-attrs))) + (when (or (not plural-val) (string= plural-val "contextual")) + (push `(plural . ,(if (> (length var-value) 1) "always" "never")) + label-attrs))) + (if with-label + (let ((rendered-label (car (citeproc--label label-attrs context)))) + (citeproc-rt-join-formatted `((rendered-var . ,var)) + (if label-before-names + (list rendered-label rendered-names) + (list rendered-names rendered-label)) + context)) + (push (cons 'rendered-var var) (car rendered-names)) + rendered-names))) + +(defun citeproc-name--render-names (names attrs et-al-attrs name-part-attrs context) + "Render NAMES according to the given attrs." + (let* ((all-attrs (-concat attrs (citeproc-context-opts context))) + (rmode (citeproc-context-render-mode context)) + (sort-o (if (eq rmode 'sort) "all" ;; special setting for sort mode + (alist-get 'name-as-sort-order all-attrs))) + (names-count (length names)) + (formatted-first (citeproc-name--render (car names) attrs name-part-attrs + sort-o context))) + (if (= 1 names-count) formatted-first + (let-alist all-attrs + (let ((delimiter (or .delimiter .name-delimiter ", ")) + (add-names (or .add-names 0)) + (position (citeproc-var-value 'position context))) + (unless (or (null position) (eq position 'first)) + (setq .et-al-min (or .et-al-subsequent-min .et-al-min) + .et-al-use-first (or .et-al-subsequent-use-first .et-al-use-first))) + (setq .et-al-min (or .names-min .et-al-min) + .et-al-use-first (or .names-use-first .et-al-use-first) + .et-al-use-last (or (string= .names-use-last "true") + (string= .et-al-use-last "true"))) + (let* ((et-al-min-val + ;; If et-al should be ignored then we set this to an unreachable number. + (if (alist-get 'ignore-et-al (citeproc-context-vars context)) + 100 + (citeproc-s-nil-or-s-to-num .et-al-min))) + (et-al-use-first-val (+ add-names + (citeproc-s-nil-or-s-to-num .et-al-use-first))) + (et-al (and .et-al-min .et-al-use-first + (>= names-count et-al-min-val) + (< et-al-use-first-val names-count))) + (middle-end-pos (if et-al et-al-use-first-val (- names-count 1))) + (sort-o-latters (string= sort-o "all")) + (formatted-middle + (if (< middle-end-pos 2) + nil + (citeproc-rt-join-formatted + `((delimiter . ,delimiter) (prefix . ,delimiter)) + (--map (citeproc-name--render it attrs name-part-attrs + sort-o-latters context) + (-slice names 1 middle-end-pos)) + context))) + (last-after-inverted (or sort-o-latters + (and (string= sort-o "first") + (null formatted-middle)))) + (last-delim (citeproc-lib-intern (if et-al .delimiter-precedes-et-al + .delimiter-precedes-last))) + (last-pref (if (or (and (or (not last-delim) (eq last-delim 'contextual)) + (> middle-end-pos 1)) + (eq last-delim 'always) + (and (eq last-delim 'after-inverted-name) + last-after-inverted)) + delimiter + " ")) + (formatted-last + (cond (et-al (if .et-al-use-last + (citeproc-rt-join-formatted + nil + (list + delimiter "… " + (citeproc-name--render (-last-item names) + attrs name-part-attrs + sort-o-latters context)) + context) + (citeproc-name--render-et-al (cons `(prefix . ,last-pref) + et-al-attrs) + context))) + (.and + (let ((and-str (if (string= .and "text") + (citeproc-term-get-text "and" context) + "&"))) + (citeproc-rt-join-formatted + `((prefix . ,last-pref)) + (list and-str " " + (citeproc-name--render + (-last-item names) attrs + name-part-attrs sort-o-latters context)) + context))) + (t + (citeproc-rt-join-formatted + nil + (list delimiter + (citeproc-name--render (-last-item names) + attrs name-part-attrs + sort-o-latters context)) + context))))) + (citeproc-rt-join-formatted + (--remove (eq 'delimiter (car it)) attrs) + (list formatted-first formatted-middle formatted-last) + context))))))) + +(defun citeproc-name--render (name attrs name-part-attrs sort-o context) + "Render NAME according to the given attributes." + (let* ((format-attrs + (--filter (memq (car it) (-concat '(prefix suffix) citeproc-rt-format-attrs)) + attrs)) + (result (citeproc-rt-format-single + (cons `(name-id . ,(alist-get 'name-id name)) format-attrs) + (citeproc-name--render-formatted + (citeproc-name--format-nameparts name name-part-attrs context) + attrs sort-o context) + context))) + (dolist (fn citeproc-name-postprocess-functions) + (setq result (funcall fn result name context))) + result)) + +(defun citeproc-name--parts-w-sep (c1 c2 sep context) + "Join name-parts in lists C1 C2 with spaces and then with SEP." + (let ((joined-c1 (citeproc-rt-join-formatted '((delimiter . " ")) c1 context))) + (if (-none-p 'cadr c2) + joined-c1 + (citeproc-rt-join-formatted + `((delimiter . ,sep)) + (list joined-c1 + (citeproc-rt-join-formatted '((delimiter . " ")) c2 context)) + context)))) + +(defun citeproc-name--render-formatted (name-alist attrs sort-o context) + "Render formatted name described by NAME-ALIST according to ATTRS. +NAME-ALIST is an alist with symbol keys corresponding to +name-parts like `family' etc. and values are simple rich-text +contents of the form (ATTRS CONTENT) where content must be a +single string. SORT-O is a boolean determining whether to use +sort order." + (-let* ((global-opts (citeproc-context-opts context)) + ((&alist 'family f + 'given g-uninited + 'suffix s + 'dropping-particle d + 'non-dropping-particle n + 'name-id nid) + name-alist) + ((&alist 'sort-separator sort-sep + 'initialize init + 'initialize-with init-with + 'form form + 'name-form name-form) + (-concat attrs global-opts)) + (sort-sep (or sort-sep ", ")) + (init (not (string= init "false"))) + (d-n-d (intern (alist-get 'demote-non-dropping-particle global-opts))) + (id (cadr nid)) + (show-given (citeproc-name-show-givenname-level id context)) + (form (if show-given 'long + (intern (or form name-form "long")))) + (rmode (citeproc-context-render-mode context))) + (if (citeproc-name--lat-cyr-greek-p name-alist) + (let ((g + (cond ((or (null g-uninited) + (and show-given (= show-given 2))) + g-uninited) + ((and init-with init) + (list (citeproc-rt-attrs g-uninited) + (citeproc-name--initialize + (citeproc-rt-first-content g-uninited) + init-with + (string= "false" + (alist-get 'initialize-with-hyphen + global-opts))))) + (init-with + (list (citeproc-rt-attrs g-uninited) + (citeproc-name--initials-add-suffix + init-with + (citeproc-rt-first-content g-uninited)))) + (t g-uninited)))) + (if (eq form 'long) + (if sort-o + (if (or (eq d-n-d 'never) + (and (eq d-n-d 'sort-only) (eq rmode 'display))) + (citeproc-name--parts-w-sep + (citeproc-name--conc-nps n f) (list g d s) sort-sep + context) + (citeproc-name--parts-w-sep (list f) (list g d n s) sort-sep context)) + (citeproc-rt-join-formatted + '((delimiter . " ")) `(,g ,@(citeproc-name--conc-nps + d n f) ,s) + context)) + (citeproc-rt-join-formatted + '((delimiter . " ")) (citeproc-name--conc-nps n f) context))) + (if (eq form 'long) + (citeproc-rt-join-formatted '((delimiter . " ")) (list f g-uninited) context) + f)))) + +(defun citeproc-name--conc-nps (&rest nps) + "Concatenate particles in name-parts NPS if they end with apostrophe." + (let ((nonnils (delq nil nps))) + (if (cdr nonnils) + (let* ((len (length nonnils)) + (particle (nth (- len 2) nonnils)) + (particle-str (if (listp particle) (cadr particle) particle))) + (if (string= "ʼ" (substring particle-str -1)) + (let* ((family (car (last nonnils))) + (result (list (list nil particle family)))) + (when (> 2 len) (push (car nonnils) result)) + result) + nonnils)) + nonnils))) + +(defun citeproc-name--lat-cyr-greek-p (name-alist) + "Return t if NAME-ALIST is cyrillic/latin/greek and nil otherwise. +NAME-ALIST is like in `citeproc-name--render-formatted'" + (--all-p (or (not (stringp it)) (string-match "^\\(\\cl\\|\\cy\\|\\cg\\|ʼ\\)*$" + it)) + (-map (lambda (x) + (if (listp (cdr x)) (cl-caddr x) + (cdr x))) + name-alist))) + +(defun citeproc-name--initialize (names suffix &optional remove-hyphens) + "Initialize NAMES and add SUFFIX. +NAMES is a string containing one or more space-separated names, +while SUFFIX is either nil or a string (e.g. \".\"). If the +optional REMOVE-HYPHENS is non-nil then don't keep hyphens +between initalized given names, e.g., initialize Jean-Paul to +J.P. instead of the default J.-P." + (let ((trimmed-suffix (s-trim suffix))) + (concat (s-join + suffix + (--map + (if (s-match "-" it) + (citeproc-name--initialize-hyphenated it suffix remove-hyphens) + (s-left 1 it)) + (s-split " +" names))) + trimmed-suffix))) + +(defun citeproc-name--initialize-hyphenated (name suffix &optional remove-hyphens) + "Initialize space-less but hyphenated NAME with SUFFIX. +If the optional REMOVE-HYPHENS is non-nil then don't keep hyphens +between the initalized given names, e.g., initialize Jean-Paul to +J.P. instead of the default J.-P." + (let ((inner-suffix (s-trim suffix))) + (s-join (if remove-hyphens inner-suffix + (concat inner-suffix "-")) + (--map (s-left 1 it) + (s-split "-" name))))) + +(defun citeproc-name--initials-add-suffix (suffix names) + "Add SUFFIX to initials in NAMES. +NAMES is a string containing one or more space-separated names, +while SUFFIX is a string (e.g. \".\")." + (let ((suffix (s-trim suffix))) + (mapconcat (lambda (x) + (if (and (cdr x) (s-match "^[[:alpha:]]$" (car x))) + (concat (car x) suffix) + (car x))) + (citeproc-s-slice-by-matches names "[ \\-]" 0 t) + ""))) + +(defun citeproc-name--format-nameparts (name-alist name-part-attrs context) + "Format nameparts in NAME-ALIST according to NAME-PART-ATTRS. +Return a new name alist containg the same keys with formatted +contents." + (-let (((&alist 'given given-attrs + 'family family-attrs) + name-part-attrs)) + (--map (-let (((n-part . content) it)) + (cons n-part + (cond ((and given-attrs + (memq n-part '(given dropping-particle))) + (citeproc-rt-format-single given-attrs content context)) + ((and family-attrs + (memq n-part '(family non-dropping-particle))) + (citeproc-rt-format-single family-attrs content context)) + (t (list nil content))))) + name-alist))) + +(defun citeproc-name--render-et-al (attrs context) + "Render the `et al' part of a name acc. to ATTRS." + (let ((rmode (citeproc-context-render-mode context))) + (if (eq rmode 'sort) "" + (let ((term (or (alist-get 'term attrs) + "et-al"))) + (citeproc-rt-format-single attrs + (citeproc-term-get-text term context) + context))))) + +(defun citeproc-name-show-givenname-level (id context) + "Return the disambiguation level of name with ID." + (alist-get id (alist-get 'show-given-names (citeproc-context-vars context)))) + +(defun citeproc--var-plural-p (var context) + "Return whether the content of variable VAR is plural. +VAR is a symbol." + (let ((content (citeproc-rt-to-plain (citeproc-var-value var context)))) + (if (or (string= var "number-of-pages") + (string= var "number-of-volumes")) + (> (string-to-number content) 1) + (string-match-p + (concat "[[:digit:]] *\\([-,;–&—―]+\\|[,;]? *" + (citeproc-term-get-text "and" context) + "\\) *[a-zA-Z]?[[:digit:]]") + content)))) + +(defun citeproc--label (attrs context &rest _body) + "Render a CSL label element with the given ATTRS in CONTEXT." + (-let* (((&alist 'variable variable + 'form form + 'plural plural) + attrs) + (label (intern variable)) + (number nil)) + (if (or (eq label 'editortranslator) + (and label (citeproc-var-value label context))) + (progn + (if form (setq form (intern form)) + (setq form 'long)) + (when (string= variable "locator") + (setq variable (citeproc-locator-label context))) + (cond ((string= plural "never") (setq number 'single)) + ((string= plural "always") (setq number 'multiple)) + (t (setq number + (if (citeproc--var-plural-p label context) + 'multiple + 'single)))) + ;; Add rendered locator label info in cite mode. + (when (and (eq label 'locator) + (eq (citeproc-context-mode context) 'cite)) + (push '(rendered-locator-label . t) attrs)) + (cons (citeproc-rt-format-single attrs (citeproc-term-inflected-text + variable form number context) + context) + 'text-only)) + (cons nil 'text-only)))) + +(provide 'citeproc-name) + +;;; citeproc-name.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-number.el b/elpa/citeproc-20240722.1110/citeproc-number.el new file mode 100644 index 00000000..bf9897bf --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-number.el @@ -0,0 +1,160 @@ +;;; citeproc-number.el --- render CSL number elements -*- lexical-binding: t; -*- + +;; Copyright "(C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to render CSL number elements. + +;;; Code: + +(require 'subr-x) +(require 'rst) +(require 's) + +(require 'citeproc-context) +(require 'citeproc-lib) +(require 'citeproc-s) +(require 'citeproc-rt) + +(defun citeproc-number-extract (val) + "Return the parse of string VAL holding numeric content." + (cdr (s-match + "\\`\\([[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)\\(?:\\(?: *\\([,&-–—―]\\|--\\) *\\)\\([[:alpha:]]?[[:digit:]]+[[:alpha:]]*\\)\\)?\\'" + val))) + +(defun citeproc--number (attrs context &rest _body) + "Render a cs:number element with the given ATTRS in CONTEXT." + (-let* (((&alist 'variable var + 'form form) + attrs) + (variable (intern var)) + (value (citeproc-var-value variable context)) + (form (citeproc-lib-intern form))) + (if (not value) + (cons nil 'empty-var) + (let ((result-attrs + (cons `(rendered-var . ,variable) attrs)) + (result-cont + (citeproc-number-var-value value variable form context))) + (cons (citeproc-rt-format-single result-attrs result-cont context) + 'present-var))))) + +(defconst citeproc--format-numsep-alist + '(("&" . " & ") + ("," . ", ") + ("-" . "-") + ("--" . "-") + ("—" . "-") + ("―" . "-")) + "Alist specifying the proper formatting of number-pair separators.") + +(defun citeproc-number-var-value (value variable form context) + "Return the numeric VALUE of VARIABLE formatted in FORM. +VARIABLE is a symbol." + (cond ((not value) nil) + ((numberp value) (number-to-string value)) + (t (--if-let (citeproc-number-extract value) + (let ((formatted-first + (citeproc-number--format (car it) form variable context))) + (if (> (length it) 1) + (concat + formatted-first + (assoc-default (cadr it) citeproc--format-numsep-alist) + (citeproc-number--format (cl-caddr it) form variable context)) + formatted-first)) + value)))) + +(defun citeproc-number--format (s form term context) + "Render the number in string S for TERM in format FORM." + (if (s-matches-p "[[:alpha:]]" s) s + (pcase form + ('roman (downcase (rst-arabic-to-roman (string-to-number s)))) + ('ordinal (citeproc-number--format-as-ordinal s term context)) + ('long-ordinal (citeproc-number--format-as-long-ordinal s term context)) + (_ s)))) + +(defun citeproc-number--format-as-ordinal (s term context) + "Format numeric string S as ordinal agreeing with TERM." + (let* ((terms (citeproc-context-terms context)) + (padded (if (= 1 (length s)) + (concat "0" s) + s)) + (gender (citeproc-term-get-gender term context)) + (matches + (--filter (and (string= (s-left 8 (citeproc-term-name it)) "ordinal-") + (citeproc-number--ordinal-matches-p padded gender it)) + terms)) + (suffix + (citeproc-term-text + (if (not matches) + (-when-let (ordinal-matches + (--filter (string= (citeproc-term-name it) "ordinal") + terms)) + (-if-let (match (--first (eq (citeproc-term-gender-form it) gender) + ordinal-matches)) + match + (car ordinal-matches))) + (let ((first-term (car matches))) + (-if-let (second-term (cadr matches)) + (if (= (elt (citeproc-term-name first-term) 8) ?0) + second-term + first-term) + first-term)))))) + (concat s suffix))) + +(defconst citeproc-number--ordinal-match-alist + '((last-two-digits . 2) + (last-digit . 1) + (whole-number . nil)) + "Alist mapping ordinal match attributes to the required match lengths.") + +(defun citeproc-number--ordinal-matches-p (s gender ord-term) + "Whether S term with GENDER matches ordinal-term ORD-TERM." + (and (eq gender (citeproc-term-gender-form ord-term)) + (let ((match (citeproc-term-match ord-term)) + (term-num (s-right 2 (citeproc-term-name ord-term)))) + (unless match + (setq match + (if (= (elt (citeproc-term-name ord-term) 8) ?0) + 'last-digit + 'last-two-digits))) + (let ((l (assoc-default match citeproc-number--ordinal-match-alist))) + (string= (citeproc-s-tail s l) + (citeproc-s-tail term-num l)))))) + +(defun citeproc-number--format-as-long-ordinal (s term context) + "Format numeric string S as a long ordinal agreeing with TERM." + (let ((num-val (string-to-number s))) + (if (> num-val 10) + (citeproc-number--format-as-ordinal s term context) + (when (= 1 (length s)) (setq s (concat "0" s))) + (let* ((name (concat "long-ordinal-" s)) + (gender (citeproc-term-get-gender term context)) + (match (--first (and (string= (citeproc-term-name it) name) + (eq (citeproc-term-gender-form it) gender)) + (citeproc-context-terms context)))) + (if match + (citeproc-term-text match) + (citeproc-term-get-text name context)))))) + +(provide 'citeproc-number) + +;;; citeproc-number ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-pkg.el b/elpa/citeproc-20240722.1110/citeproc-pkg.el new file mode 100644 index 00000000..f64f89c5 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-pkg.el @@ -0,0 +1,18 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "citeproc" "20240722.1110" + "A CSL 1.0.2 Citation Processor." + '((emacs "26") + (dash "2.13.0") + (s "1.12.0") + (f "0.18.0") + (queue "0.2") + (string-inflection "1.0") + (org "9") + (parsebib "2.4") + (compat "28.1")) + :url "https://github.com/andras-simonyi/citeproc-el" + :commit "54184baaff555b5c7993d566d75dd04ed485b5c0" + :revdesc "54184baaff55" + :keywords '("bib") + :authors '(("András Simonyi" . "andras.simonyi@gmail.com")) + :maintainers '(("András Simonyi" . "andras.simonyi@gmail.com"))) diff --git a/elpa/citeproc-20240722.1110/citeproc-prange.el b/elpa/citeproc-20240722.1110/citeproc-prange.el new file mode 100644 index 00000000..9db65f0b --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-prange.el @@ -0,0 +1,130 @@ +;;; citeproc-prange.el --- page-range rendering -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to render CSL page-ranges. + +;;; Code: + +(require 'citeproc-s) + +(defun citeproc-prange--end-significant (start end len) + "Return the significant digits of the end in page range START END. +START and END are strings of equal length containing integers. If +the significant part of END is shorter than LEN then add +insignificant digits from END until the string is LEN long or +there are no more digits left." + (let ((first (min (max 1 (1+ (- (length end) len))) + (abs (compare-strings start nil nil end nil nil))))) + (substring end (1- first)))) + +(defun citeproc-prange--end-complete (start end len) + "Complete the closing form of a START END pagerange to LEN." + (citeproc-prange--end-significant start (citeproc-s-fill-copy end start) len)) + +(defun citeproc-prange--end-expanded (_start end end-pref) + "Render the end of range _START END in `expanded' format. +END-PREF is an optional non-numeric prefix preceding END. All +arguments are strings, END has the same length as START." + (concat end-pref end)) + +(defun citeproc-prange--end-minimal (start end _end-pref) + "Render the end of range START END in `minimal' format. +END-PREFIX is an optional non-numeric prefix preceding END. All +arguments are strings, END has the same length as START." + (citeproc-prange--end-significant start end 1)) + +(defun citeproc-prange--end-minimal-two (start end _end-pref) + "Render the end of range START END in `minimal-two' format. +END-PREFIX is an optional non-numeric prefix preceding END. All +arguments are strings, END has the same length as START." + (citeproc-prange--end-significant start end 2)) + +(defun citeproc-prange--end-chicago (start end _end-pref &optional 15th-ed) + "Render the end of range START END in `chicago' format. +END-PREFIX is an optional non-numeric prefix preceding END. All +arguments are strings, END has the same length as START. If +optional 15TH-ED is non-nil then use the special 4digit rule of +the 15th edition." + (let ((len (length start))) + (cond ((or (< len 3) (string= (substring start -2) "00")) + end) + ((string= (substring start -2 -1) "0") + (citeproc-prange--end-significant start end 1)) + ((and 15th-ed (= 4 (length start))) + (let ((min-two (citeproc-prange--end-significant start end 2))) + (if (> (length min-two) 2) end min-two))) + (t (citeproc-prange--end-significant start end 2))))) + +(defconst citeproc-prange-formatters-alist + `((chicago . ,(lambda (start end end-pref) + (citeproc-prange--end-chicago start end end-pref t))) + (chicago-15 . ,(lambda (start end end-pref) + (citeproc-prange--end-chicago start end end-pref t))) + (chicago-16 . citeproc-prange--end-chicago) + (minimal . citeproc-prange--end-minimal) + (minimal-two . citeproc-prange--end-minimal-two) + (expanded . citeproc-prange--end-expanded)) + "Alist mapping page range formats to formatter functions.") + +(defun citeproc-prange-render (p format sep) + "Render page range P in FORMAT with separator SEP." + (with-temp-buffer + (insert p) + (goto-char 0) + (while (search-forward-regexp + "\\([[:digit:]]*[[:alpha:]]\\)?\\([[:digit:]]+\\)\\( ?\\)\\([-–—]+\\)\\( ?\\)\\([[:digit:]]*[[:alpha:]]\\)?\\([[:digit:]]+\\)" + nil t) + (let* ((start-pref (match-string 1)) + (start-num (match-string 2)) + (orig-dash (match-string 4)) + (orig-sep (concat (match-string 3) orig-dash (match-string 5))) + (end-pref (match-string 6)) + (end-num (match-string 7)) + (end (concat end-pref end-num)) + (old-sep-w-end (concat orig-sep end)) + ;; Note: To conform with the official CSL tests we don't replace the separating + ;; dash with SEP if collapse cannot be applied because of incompatible prefixes + ;; but we still remove spaces surrounding the dash. It would make far more + ;; sense to replace the dash as well. + (new-sep-w-end (cond ((not (string= start-pref end-pref)) + (concat orig-dash end)) + ;; Deal with degenerate single page "ranges" + ((string= start-num end-num) + "") + ((or (not format) (> (length end-num) (length start-num))) + (concat sep end)) + (t (concat + sep + (funcall (alist-get format + citeproc-prange-formatters-alist) + start-num + (citeproc-s-fill-copy end-num start-num) + end-pref)))))) + (unless (string-equal new-sep-w-end old-sep-w-end) + (delete-char (- (length old-sep-w-end))) + (insert new-sep-w-end)))) + (buffer-string))) + +(provide 'citeproc-prange) + +;;; citeproc-prange.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-proc.el b/elpa/citeproc-20240722.1110/citeproc-proc.el new file mode 100644 index 00000000..001e734d --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-proc.el @@ -0,0 +1,243 @@ +;;; citeproc-proc.el --- construct and manage citation processors -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; 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 &optional uncited) + "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 :uncited uncited))) + (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 t)))))) + +(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-json-name (rep) + "Parse the json representation REP of a csl name variable." + (if-let ((literal (alist-get 'literal rep))) + (list (cons 'family (citeproc-s-smart-apostrophes literal))) + (let ((filtered (-remove (lambda (x) (eq (car x) 'isInstitution)) rep))) + (--map (cons + (car it) + (let ((text-field (cdr it))) + (if (stringp text-field) + (citeproc-s-smart-apostrophes text-field) + text-field))) + filtered)))) + +(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 (citeproc-proc--internalize-name + (citeproc-proc--parse-csl-json-name it) + 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))))) + +(defun citeproc-proc-filtered-bib-p (proc) + "Return whether PROC has nontrivial filters" + (let ((filters (citeproc-proc-bib-filters proc))) + (and filters (not (equal filters '(nil)))))) + +(defun citeproc-proc-max-offset (itds) + "Return the maximal first field width of bibitems in ITDS. +ITDS should be the value of the itemdata field of a citeproc-proc +structure." + (cl-loop for itd being the hash-values of itds + when (listp (citeproc-itemdata-rawbibitem itd)) maximize + (length (citeproc-rt-to-plain (cadr (citeproc-itemdata-rawbibitem itd)))))) + +(provide 'citeproc-proc) + +;;; citeproc-proc.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-rt.el b/elpa/citeproc-20240722.1110/citeproc-rt.el new file mode 100644 index 00000000..26d06222 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-rt.el @@ -0,0 +1,645 @@ +;; citeproc-rt.el --- citeproc-el rich-text functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions operating on rich-text contents. In citeproc-el, rich-texts are +;; represented either by strings or by lists of the form (ATTRS RT_1 RT_2...) +;; where ATTRS is an alist consisting of (FORMAT-ATTR . VALUE) pairs and RT_1, +;; RT_2... are all rich-texts. The constants `citeproc-rt-format-attrs' and +;; `citeproc-rt-ext-format-attrs' define the list of normal and extended format +;; attributes, respectively. As a degenerate case, nil is also a legitimate +;; rich-text. + +;;; Code: + +(require 'subr-x) +(require 'dash) +(require 'cl-lib) +(require 'let-alist) +(require 's) +(require 'compat) + +(require 'citeproc-s) +(require 'citeproc-lib) + +(defconst citeproc-rt-format-attrs + '(font-variant font-style font-weight text-decoration vertical-align font-variant + display rendered-var name-id quotes cited-item-no bib-item-no + rendered-names href stopped-rendering rendered-locator-label) + "The rich-text content format attributes (used in raw output).") + +(defconst citeproc-rt-ext-format-attrs + (-concat '(prefix suffix delimiter subst quotes) citeproc-rt-format-attrs) + "The list of extended format attributes.") + +(defun citeproc-rt-to-plain (rt) + "Return the plain-text content of rich-text RT." + (if (listp rt) + (mapconcat 'citeproc-rt-to-plain + (cdr rt) + "") + rt)) + +(defun citeproc-rt-attrs (rt) + "Return the attrs of rich content RT." + (if (listp rt) (car rt) nil)) + +(defun citeproc-rt-first-content (rt) + "Return the first content element of rich content RT." + (if (listp rt) (cadr rt) rt)) + +(defun citeproc-rt-select-attrs (attrs keep) + "Select attr-val pairs from alist ATTRS whose attr is in KEEP." + (--filter (memq (car it) keep) + attrs)) + +(defun citeproc-rt-join-strings (rt) + "Concatenate consecutive strings in rich-text RT." + (cond ((< (length rt) 2) + rt) + ((and (char-or-string-p (car rt)) + (char-or-string-p (cadr rt))) + (citeproc-rt-join-strings (cons (concat (car rt) + (cadr rt)) + (cddr rt)))) + (t (cons (car rt) + (citeproc-rt-join-strings (cdr rt)))))) + +(defun citeproc-rt-splice-unformatted (rt) + "Splice the body of its unformatted elements into rich-text RT." + (if (and (consp rt) (not (alist-get 'delimiter (car rt)))) + (cons (car rt) + (--mapcat (if (citeproc-rt-formatting-empty-p it) + (cdr it) + (list it)) + (cdr rt))) + rt)) + +(defun citeproc-rt-formatting-empty-p (rt) + "Is the formatting of rich-text RT empty/redundant?" + (and (consp rt) (or (not (caar rt)) + (and (eq (cl-caaar rt) 'delimiter) + (= (length (car rt)) 1) + (= (length rt) 2))))) + +(defun citeproc-rt-reduce-content (rt) + "Reduce rich-text RT if it has no attributes or body. +Return the original RT if it has non-empty attrs and content." + (cond ((not (cdr rt)) nil) + ((and (not (car rt)) (= (length rt) 2)) (cadr rt)) + (t rt))) + +(defun citeproc-rt-simplify-shallow (rt) + "Simplify the first level of rich-text RT." + (citeproc-rt-reduce-content (citeproc-rt-join-strings + (citeproc-rt-splice-unformatted rt)))) + +(defun citeproc-rt-simplify-deep (rt) + "Simplify all levels of rich-text RT." + (if (not (consp rt)) rt + (-let* (((attrs . conts) rt) + (simplifieds (--map (citeproc-rt-simplify-deep it) + conts))) + (citeproc-rt-reduce-content + (citeproc-rt-join-strings + (citeproc-rt-splice-unformatted (cons attrs simplifieds))))))) + +(defun citeproc-rt-map-strings (fun rts &optional skip-nocase) + "Map through FUN all strings in rich-texts RTS. +Return a new rich-text with all S content strings replaced by the +value of FUN applied to S. No formatting is changed. If optional +SKIP-NOCASE is non-nil then skip spans with the `nocase' +attribute set to non-nil." + (--map (citeproc-rt-format it fun skip-nocase) rts)) + +(defun citeproc-rt-format (rt fun &optional skip-nocase) + "Format all plain text in RT with FUN. +If optional SKIP-NOCASE is non-nil then skip spans with the +`nocase' attribute set to non-nil." + (pcase rt + (`nil nil) + ((pred listp) (if (and skip-nocase (alist-get 'nocase (car rt))) + rt + (cons (car rt) (citeproc-rt-map-strings fun (cdr rt) skip-nocase)))) + (_ (funcall fun rt)))) + +(defun citeproc-rt-replace-all-sim (replacements regex rts) + "Make all REPLACEMENTS simultaneously in the strings of rich-texts RTS." + (citeproc-rt-map-strings (lambda (x) (citeproc-s-replace-all-sim x regex replacements)) + rts)) + +(defun citeproc-rt-strip-periods (rts) + "Remove all periods from rich-texts RTS." + (citeproc-rt-map-strings (lambda (x) (string-replace "." "" x)) rts)) + +(defun citeproc-rt-length (rt) + "Return the length of rich-text RT as a string." + (if (listp rt) + (-sum (mapcar #'citeproc-rt-length (cdr rt))) + (length rt))) + +(defun citeproc-rt--update-from-plain-1 (rt p start &optional skip-nocase) + "Update rich-text RT from plain text P from position START in P. +The length of the plain text content of RT must not be less than +the length of P. If optional SKIP-NOCASE is non-nil then skip +spans with the `nocase' attribute set to non-nil. + Return an (UPDATED . NEXT) pair where UPDATED is the updated +rich-text and NEXT is the first position in P which was not used +for the update." + (pcase rt + (`nil nil) + ((pred listp) + (if (and skip-nocase (alist-get 'nocase (car rt))) + (cons rt (+ start (citeproc-rt-length rt))) + (let ((act-start start)) + (cons (cons (car rt) + (--map (-let (((updated . next) + (citeproc-rt--update-from-plain-1 + it p act-start skip-nocase))) + (setq act-start next) + updated) + (cdr rt))) + act-start)))) + (_ (let ((end (+ start (length rt)))) + (cons (substring p start end) end))))) + +(defun citeproc-rt-update-from-plain (rt p &optional skip-nocase) + "Update rich-text RT from plain text P. +The length of the plain text content of RT must not be less than +the length of P. Return the updated rich-text. If optional +SKIP-NOCASE is non-nil then skip spans with the `nocase' +attribute set to non-nil." + (car (citeproc-rt--update-from-plain-1 rt p 0 skip-nocase))) + +(defun citeproc-rt-change-case (rt case-fun) + "Change the case of rich text RT with CASE-FUN. +CASE-FUN is a function taking a string as its argument and +returning a string of the same length." + (let ((plain (citeproc-rt-to-plain rt))) + (citeproc-rt-update-from-plain rt (funcall case-fun plain) t))) + +(defun citeproc-rt-pred-counts-tree (rt pred) + "Return a dominated count tree for rich text RT based on PRED. +The returned tree has the same structure as RT but the car of +each subtree is a number indicating the maximal number of nodes +on any dominated branch for which PRED holds." + (if (consp rt) + (let ((children-vals (--map (citeproc-rt-pred-counts-tree it pred) + (cdr rt)))) + (cons (-max (cl-mapcar (lambda (rich count) + (+ (if (listp count) (car count) count) + (if (funcall pred rich) 1 0))) + (cdr rt) + children-vals)) + children-vals)) + 0)) + +(defun citeproc-rt-flip-italics (rt) + "Flip the italic attribute of rich text RT." + (if (listp rt) + (cons (if (citeproc-rt-in-italics-p rt) + (--remove (eq (car it) 'font-style) (car rt)) + (cons '(font-style . "italic") (car rt))) + (cdr rt)) + `(((font-style . "italic")) ,rt))) + +(defun citeproc-rt-in-italics-p (rt) + "Whether rich text RT has italic font style as attribute." + (and (listp rt) + (string= (alist-get 'font-style (car rt)) "italic"))) + +(defun citeproc-rt-italics-flipflop (rt) + "Return a flipflopped italics version of rich text RT." + (if (and rt (listp rt)) + (let ((italics-counts-tree + (citeproc-rt-pred-counts-tree rt 'citeproc-rt-in-italics-p))) + (if (> (+ (car italics-counts-tree) + (if (citeproc-rt-in-italics-p rt) 1 0)) + 1) + (citeproc-rt--italics-flipflop-1 rt italics-counts-tree) + rt)) + rt)) + +(defun citeproc-rt--italics-flipflop-1 (rt italics-counts-tree) + "Flipflop italics in RT using info from ITALICS-COUNTS-TREE." + (let ((rt-italic (citeproc-rt-in-italics-p rt))) + (if (or (not (listp rt)) + (not (listp italics-counts-tree)) + (< (+ (car italics-counts-tree) + (if rt-italic 1 0)) + 2)) rt + (if rt-italic + (cons (--remove (eq (car it) 'font-style) (car rt)) + (cl-mapcar (lambda (r i) + (citeproc-rt--italics-flipflop-1 + (citeproc-rt-flip-italics r) i)) + (cdr rt) + (cdr italics-counts-tree))) + (cons (car rt) + (cl-mapcar (lambda (r i) (citeproc-rt--italics-flipflop-1 r i)) + (cdr rt) + (cdr italics-counts-tree))))))) + +(defun citeproc-rt-from-str (s) + "Parse a html or plain text string S into rich text." + (if (and s (s-matches-p "" s)) + (let* ((parsed (citeproc-lib-parse-html-frag s)) + (body (cddr (cl-caddr parsed))) + (stripped (if (eq (caar body) 'p) (cl-cddar body) body))) + (if (= 1 (length stripped)) + (citeproc-rt-from-html (car stripped)) + (cons nil (mapcar 'citeproc-rt-from-html stripped)))) + s)) + +(defconst citeproc-rt-from-html-alist + '(((i . nil) . (font-style . "italic")) + ((b . nil) . (font-weight . "bold")) + ((span . ((style . "font-variant:small-caps;"))) . (font-variant . "small-caps")) + ((sc . nil) . (font-variant . "small-caps")) + ((sup . nil) . (vertical-align . "sup")) + ((sub . nil) . (vertical-align . "sub")) + ((span . ((class . "nocase"))) . (nocase . t)) + ((span . ((class . "underline"))) . (text-decoration . "underline"))) + "A mapping from html tags and attrs to rich text attrs.") + +(defun citeproc-rt-from-html (h) + "Convert simple html H to rich text." + (if (listp h) + (cons (-if-let (attr (assoc-default (cons (car h) (cadr h)) + citeproc-rt-from-html-alist)) + (list attr) + '(nil)) + (mapcar #'citeproc-rt-from-html (cddr h))) + h)) + +(defun citeproc-rt--cquote-pstns-1 (rt offset) + "Return closing quote positions in rich text RT with OFFSET. +The positions are in the plain text of RT and only those +positions are returned which are associated with a CSL +`quotes'=\"yes\" attribute." + (if (listp rt) + (let ((inner (let ((act-offset offset) + pstns) + (--each (cdr rt) + (-let (((p . next) + (citeproc-rt--cquote-pstns-1 it act-offset))) + (setq pstns (nconc pstns p) + act-offset next))) + (cons pstns act-offset)))) + (if (string= (alist-get 'quotes (car rt)) "true") + (-let (((inner-pstns . inner-offset) inner)) + (cons (cons (1- inner-offset) inner-pstns) + inner-offset)) + inner)) + (cons nil (+ offset (length rt))))) + +(defun citeproc-rt--cquote-pstns (rt) + "Return a list of closing quote positions in RT. +The positions are in the plain text of RT and only those +positions are returned which are associated with a CSL +`quotes'=\"yes\" attribute. Numbering starts from 1. +The positions are in decreasing order." + (sort (car (citeproc-rt--cquote-pstns-1 rt 1)) '>)) + +(defun citeproc-rt-punct-in-quote (rt) + "Put commas and periods inside quotes in rich text RT." + (-if-let (pstns (citeproc-rt--cquote-pstns rt)) + (let ((plain (citeproc-rt-to-plain rt))) + (citeproc-rt-update-from-plain + rt + (with-temp-buffer + (insert plain) + (dolist (pos pstns) + (goto-char (1+ pos)) + (when (memq (char-after) '(?, ?.)) + (call-interactively 'transpose-chars))) + (buffer-string)))) + rt)) + +(defun citeproc-rt-find-first-node (rt pred) + "Return the first node of RT for which PRED holds. +Return nil if no such node was found." + (if (funcall pred rt) rt + (pcase rt + ;; process further if internal node with content + (`(,_ . ,body) + (let (found) + (while (and (not found) body) + (setq found (citeproc-rt-find-first-node (car body) pred)) + (pop body)) + found)) + ;; leaf or node with no content + (_ nil)))) + +(defun citeproc-rt-transform-first (rt pred transform) + "Apply TRANSFORM to the first node of RT for which PRED is non-nil. +PRED and TRANSFORM are functions taking a rich-text node as their +sole argument. Return a (RESULT . SUCCESS) pair where RESULT is +the resulting rich-text and SUCCESS is non-nil iff the +transformation was successfully carried out (i.e., a node +satisfying PRED was found)." + (if (funcall pred rt) (cons (funcall transform rt) t) + (pcase rt + ;; process further if internal node with content + (`(,attrs . ,body) + (let* (success + (new-body + (--map (if success it + (-let (((it-res . it-success) + (citeproc-rt-transform-first it pred transform))) + (setq success it-success) + it-res)) + body))) + (cons (cons attrs new-body) success))) + ;; leaf or node with no content + (_ (cons rt nil))))) + +(defun citeproc-rt-add-year-suffix (rt ys) + "Attempt to add year suffix YS to rich-text RT. +Return an (RT . SUCCESS) pair, where RT is the resulting +rich-text, and SUCCESS is non-nil iff the year-suffix has been +successfully added." + (cl-flet ((rendered-date-var-p + (node) + (and (consp node) + (memq (alist-get 'rendered-var (car node)) citeproc--date-vars))) + (add-suffix + (node) + (let ((content (cadr node))) + (if (equal content "") + (list (car node) ys) + (let ((full-ys (if (or (not (stringp content)) + (s-matches-p "[[:digit:]]$" content)) + ys + (concat "-" ys)))) + (-snoc node `(((rendered-var . year-suffix)) ,full-ys))))))) + (citeproc-rt-transform-first rt #'rendered-date-var-p #'add-suffix))) + +(defun citeproc-rt-replace-first-names (rt replacement) + "Replace RT's first name-var content with REPLACEMENT. +Return an (RT . SUCCESS) pair, where RT is the resulting +rich-text, and SUCCESS is non-nil iff the replacement has been +successful." + (cl-flet ((rendered-name-var-p + (node) + (and (consp node) + (assoc 'rendered-names (car node)))) + (replace (_node) replacement)) + (citeproc-rt-transform-first rt #'rendered-name-var-p #'replace))) + +(defun citeproc-rt-count-names (rt) + "Return a count of the rendered names in RT." + (if (consp rt) + (if (alist-get 'name-id (car rt)) 1 + (apply #'+ (mapcar #'citeproc-rt-count-names (cdr rt)))) + 0)) + +(defun citeproc-rt-cull-spaces-puncts (rt) + "Remove unnecessary characters from rich-text RT." + (let* ((plain (citeproc-rt-to-plain rt)) + (updated (citeproc-rt-update-from-plain + rt (citeproc-s-cull-spaces-puncts plain)))) + (citeproc-rt-format updated + (lambda (x) (replace-regexp-in-string "+" "" x))))) + +(defun citeproc-rt-render-affixes (rt &optional shallow) + "Render the affixes in rich-text RT. +If SHALLOW is non-nil then render only the affixes for the first +level." + (if (not (consp rt)) + rt + (-let* (((attrs . contents) rt) + (rendered + (if shallow ; We do the recursive call depending on SHALLOW + contents + (-non-nil (--map (citeproc-rt-render-affixes it) contents))))) + (if rendered + (let-alist attrs + (let ((delimited (if .delimiter + (cdr (--mapcat (list .delimiter it) rendered)) + rendered))) + (if (or .suffix .prefix) + (let (result + outer-attrs + (inner-attrs + (citeproc-rt-select-attrs attrs citeproc-rt-format-attrs))) + (when .display ; The display attribute should encompass affixes + (setq outer-attrs (list (cons 'display .display)) + inner-attrs (--remove (eq (car it) 'display) inner-attrs))) + (when .suffix (push .suffix result)) + (push (cons inner-attrs + delimited) + result) + (when .prefix (push .prefix result)) + (cons outer-attrs result)) + (cons (citeproc-rt-select-attrs attrs citeproc-rt-format-attrs) + delimited)))) + nil)))) + +(defun citeproc-rt-dedup (rt) + "Remove duplicate substituted renderings from content RT." + (car (citeproc-rt--dedup-single rt nil))) + +(defun citeproc-rt--dedup-single (rt substs) + "Remove duplicate subst. var renderings from RT. +SUBSTS contains an initial list of vars to be removed. Return +a ( ) list." + (if (not (consp rt)) + (list rt nil nil) + (-let* (((attrs . cs) rt) + ((&alist 'subst subst + 'rendered-var var) + attrs)) + (if (and var (memq var substs)) + (list nil nil nil) + (-let (((new-c s v) (citeproc-rt--dedup-multi cs substs))) + (list (cons (--reject (memq (car it) '(subst rendered-vars)) attrs) + new-c) + (if subst + (-concat v (when var (list var))) + s) + (-concat v (if var + (list var) + nil)))))))) + +(defun citeproc-rt--dedup-multi (cs substs) + (if cs + (-let* (((c s1 v1) (citeproc-rt--dedup-single (car cs) substs)) + ((cs s2 v2) (citeproc-rt--dedup-multi (cdr cs) (-concat substs s1)))) + (list (cons c cs) + (-concat s1 s2) + (-concat v1 v2))) + (list nil nil nil))) + +(defun citeproc-rt-finalize (rt &optional punct-in-quote) + "Finalize rich text RT. +If the optional PUNCT-IN-QUOTE is non-nil then put punctuation +inside quotes. + +Note: Finalization doesn't include culling, because some +rich-text transformations require the state before culling (e.g. +the replacement of subsequent authors)." + ;; The first step is to replace the internally used `modifier letter + ;; apostrophe' characters with the normal `right single quotation marks' + (citeproc-rt-format (citeproc-rt-simplify-deep + (citeproc-rt-italics-flipflop + (if punct-in-quote (citeproc-rt-punct-in-quote rt) rt))) + (lambda (x) (s-replace "ʼ" "’" x)))) + +(defun citeproc-rt--attr-values (r attr) + "Return the list of ATTR values in raw rich-text content R. +The values are ordered depth-first." + (if (listp r) + (let ((val (alist-get attr (car r))) + (body-vals (--mapcat (citeproc-rt--attr-values it attr) (cdr r)))) + (if val (cons val body-vals) + body-vals)) + nil)) + +(defun citeproc-rt-rendered-name-ids (r) + "Return the list of name ids in raw content R." + (citeproc-rt--attr-values r 'name-id)) + +(defun citeproc-rt-rendered-vars (r) + "Return the list of rendered vars in raw content R." + (citeproc-rt--attr-values r 'rendered-var)) + +(defun citeproc-rt-rendered-date-vars (r) + "Return the list of date vars in raw content R." + (--select (memq it citeproc--date-vars) (citeproc-rt-rendered-vars r))) + +(defun citeproc-rt-rendered-name-vars (r) + "Return the list of name vars in raw content R." + (--select (memq it citeproc--name-vars) (citeproc-rt-rendered-vars r))) + +;;; Helpers for bibliography rendering + +(defun citeproc-rt-subsequent-author-substitute (bib s) + "Substitute S for subsequent author(s) in BIB. +BIB is a list of bib entries in rich-text format. Return the +modified bibliography." + (let (prev-author) + (--map + (let ((author + (citeproc-rt-find-first-node + it + (lambda (x) + (and (consp x) (assoc 'rendered-names (car x))))))) + (if (equal author prev-author) + (car (citeproc-rt-replace-first-names it s)) + (prog1 it (setq prev-author author)))) + bib))) + +(defun citeproc-rt-link-title (r target) + "Link the rendered title var in rich-text R to TARGET." + (cl-flet ((rendered-var-title-p + (node) + (and (consp node) + (eq (alist-get 'rendered-var (car node)) 'title))) + (add-link + (node) + (push (cons 'href target) (car node)))) + (citeproc-rt-transform-first r #'rendered-var-title-p #'add-link))) + +(defun citeproc-rt-locator-p (r) + "Return whether rich-text R is a rendered locator." + (and (consp r) (string= (alist-get 'rendered-var (car r)) "locator"))) + +(defun citeproc-rt-locator-label-p (r) + "Return whether rich-text R is a rendered locator label." + (and (consp r) (alist-get 'rendered-locator-label (car r)))) + +(defun citeproc-rt-add-locator-label-position (r) + "Add information about locator-label position in rich-text R. +Return value is one of `label', `locator', `label-first', +`locator-first', `label-only', `locator-only' or nil. This +information is also added to the tree node attributes." + (let ((result + (cond + ((not (consp r)) nil) + ((citeproc-rt-locator-p r) 'locator) + ((citeproc-rt-locator-label-p r) 'label) + (t (let ((content (cdr r)) + first second) + (while (and content (not (and first second))) + (let* ((cur (pop content)) + (cur-order (citeproc-rt-add-locator-label-position cur))) + (pcase cur-order + ('label-first (setq first 'label second 'locator)) + ('locator-first (setq first 'locator second 'label)) + ((or 'label-only 'label) + (if first (setq second 'label) + (setq first 'label))) + ((or 'locator-only 'locator) + (if first (setq second 'locator) + (setq first 'locator)))))) + (cond + ((not first) nil) + ((not second) (if (eq first 'locator) 'locator-only 'label-only)) + (t (if (eq first 'locator) 'locator-first 'label-first)))))))) + (when result (push (cons 'l-l-pos result) (car r))) + result)) + +(defun citeproc-rt-locator-w-label (r) + "Return locator with label if found from rich-text R. +Return R if no locator or locator label was found." + (let ((l-l-pos (citeproc-rt-add-locator-label-position r))) + (if l-l-pos + (citeproc-rt-locator-w-label-1 r l-l-pos) + ;; We return the full cite if no locator was found. + r))) + +(defun citeproc-rt-locator-w-label-1 (r l-l-pos) + "Return locator-label span from rich-text fragment R. +L-L-POS is the global position of locator and label, see the +documentation of `citeproc-rt-add-locator-label-position' for the +possible values." + (if (or (citeproc-rt-locator-label-p r) (citeproc-rt-locator-p r)) r + (pcase-let* ((`(,attrs . ,content) r) + (local-llpos (alist-get 'l-l-pos attrs))) + (cons attrs + (let (result + (n-boundaries (if (or (and (eq l-l-pos 'locator-first) + (eq local-llpos 'label-only)) + (and (eq l-l-pos 'label-first) + (eq local-llpos 'locator-only))) + 1 ; Fragment starts in a between position. + 0))) ; Fragment starts in a before position. + (while (and content (< n-boundaries 2)) + (let* ((cur-rt (pop content)) + (cur-rt-llpos (and (consp cur-rt) (alist-get 'l-l-pos (car cur-rt))))) + (cond (cur-rt-llpos + ;; Element at boundary + (cl-incf n-boundaries + (if (or (eq l-l-pos 'locator-only) + (memq cur-rt-llpos '(label-first locator-first))) + 2 + 1)) + (push (citeproc-rt-locator-w-label-1 cur-rt l-l-pos) result)) + ;; Element in between position, simply pushing + ((= n-boundaries 1) + (push cur-rt result))))) + (nreverse result)))))) + +(provide 'citeproc-rt) + +;;; citeproc-rt.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-s.el b/elpa/citeproc-20240722.1110/citeproc-s.el new file mode 100644 index 00000000..88d58663 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-s.el @@ -0,0 +1,275 @@ +;;; citeproc-s.el --- citeproc-el string functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; String utility functions for citeproc-el. + +;;; Code: + +(require 'thingatpt) +(require 's) +(require 'compat) + +(defun citeproc-s-camelcase-p (s) + "Return whether string S is in camel case." + (let ((case-fold-search nil)) + (and (< 1 (length s)) + (s-matches-p "[[:upper:]]" (substring s 1)) + (s-matches-p "[[:lower:]]" s)))) + +(defun citeproc-s-fill-copy (s1 s2) + "Return a copy of string S1 filled by characters from string S2. +If string S1 is shorter than string S2 then prepend enough +characters from to beginning of S2 to the beginning of a copy of +S2 to make their length equal, and return the filled copy." + (if (>= (length s1) (length s2)) s1 + (concat (substring s2 0 (- (length s2) (length s1))) s1))) + +(defun citeproc-s-fill-left-to-len (s len &optional char) + "Fill string S to length LEN with CHAR from left." + (let ((len-s (length s)) + (char (or char ?0))) + (if (>= len-s len) s + (concat (make-string (- len len-s) char) s)))) + +(defun citeproc-s-nil-or-s-to-num (s) + "Convert S, which is a string or nil to a number. +A nil value is converted to 0." + (if s (string-to-number s) 0)) + +(defun citeproc-s-from-num-or-s (x) + "Return the content of string or number X as a number." + (if (numberp x) (number-to-string x) x)) + +(defun citeproc-s-content (s) + "Return the string content of string or symbol or nil S. +The string content of nil is defined as \"\"." + (pcase s + ((\` nil) "") + ((pred symbolp) (symbol-name s)) + (_ s))) + +(defun citeproc-s-slice-by-matches (s regexp &optional start annot) + "Slice S up at the boundaries of each REGEXP match. +Optionally start from index START. Matches are also included +among the slices, but all zero-length slices are omitted. If +optional ANNOT is non-nil then slices are given as (S . B) cons +cells where S is the slice string, while B is nil if the S slice +is a separating REGEXP match and t otherwise." + (unless start (setq start 0)) + (save-match-data + (let ((begin (string-match regexp s start))) + (if begin + (let ((end (match-end 0))) + (if (and (= begin start) (= end start)) + (citeproc-s-slice-by-matches s regexp (1+ start) annot) + (let ((result (citeproc-s-slice-by-matches (substring s end) + regexp 0 annot))) + (unless (= begin end) + (let ((slice (substring s begin end))) + (push (if annot (list slice) slice) result))) + (unless (= 0 begin) + (let ((slice (substring s 0 begin))) + (push (if annot (cons slice t) slice) result))) + result))) + (list (if annot (cons s t) s)))))) + +(defun citeproc-s-tail (s length) + "Return the closing substring of string S with length LENGTH. +Return S if LENGTH is nil or not less than the length of S." + (let ((l (length s))) + (if (and length (< length l)) + (substring s (- l length)) + s))) + +(defun citeproc-s-capitalize-first (s) + "Capitalize the first word in string S. +Return the capitalized version of S. If S contains no word or the +first word is not in lowercase then return S." + (if (s-present-p s) + (with-temp-buffer + (insert s) + (goto-char 1) + (forward-word) + (backward-word) + (let ((word (word-at-point))) + (when (s-lowercase-p word) + (capitalize-word 1))) + (buffer-string)) + s)) + +(defun citeproc-s-capitalize-all (s) + "Capitalize all lowercase words in string S. +Return the capitalized version of S. If S contains no word or the +first word is not in lowercase then return S." + (if (s-present-p s) + (with-temp-buffer + (insert s) + (goto-char 1) + (while (forward-word) + (let ((word (word-at-point))) + (when (s-lowercase-p word) + (capitalize-word -1)))) + (buffer-string)) + s)) + +(defun citeproc-s-sentence-case (s) + "Return a sentence-cased version of string S." + (if (s-present-p s) + (with-temp-buffer + (insert s) + (goto-char 1) + (let ((first t)) + (while (forward-word) + (let ((word (word-at-point))) + (cond ((s-uppercase-p word) (capitalize-word -1)) + ((and first (s-lowercase-p word)) (capitalize-word -1)))) + (when first (setq first nil)))) + (buffer-string)) + s)) + +(defun citeproc-s-sentence-case-title (s &optional omit-nocase) + "Return a sentence-cased version of title string S. +If optional OMIT-NOCASE is non-nil then omit the nocase tags from the output." + (if (s-blank-p s) s + (let ((sliced (citeproc-s-slice-by-matches + s "\\(\\|\\|: +[\"'“‘]*[[:alpha:]]\\)")) + (protect-level 0) + (first t) + result) + (dolist (slice sliced) + (push + (pcase slice + ("" (cl-incf protect-level) (if omit-nocase nil slice)) + ("" (cl-decf protect-level) (if omit-nocase nil slice)) + ;; Don't touch the first letter after a colon since it probably + ;; starts a subtitle. + ((pred (string-match-p "^: +[\"'“‘]*[[:alpha:]]")) (setq first nil) slice) + (_ (cond ((< 0 protect-level) (setq first nil) slice) + ((not first) (downcase slice)) + (t (setq first nil) + ;; We upcase the first letter and downcase the rest. + (let ((pos (string-match "[[:alpha:]]" slice))) + (if pos (concat (substring slice 0 pos) + (upcase (substring slice pos (1+ pos))) + (downcase (substring slice (1+ pos)))) + slice)))))) + result)) + (apply #'concat (nreverse result))))) + +(defconst citeproc-s-english-stopwords + '("a" "according to" "across" "afore" "after" "against" "ahead of" "along" "alongside" + "amid" "amidst" "among" "amongst" "an" "and" "anenst" "apart from" "apropos" + "around" "as" "as regards" "aside" "astride" "at" "athwart" "atop" "back to" + "barring" "because of" "before" "behind" "below" "beneath" "beside" "besides" + "between" "beyond" "but" "by" "c" "ca" "circa" "close to" "d'" "de" "despite" "down" + "due to" "during" "et" "except" "far from" "for" "forenenst" "from" "given" "in" + "inside" "instead of" "into" "lest" "like" "modulo" "near" "next" "nor" "of" "off" + "on" "onto" "or" "out" "outside of" "over" "per" "plus" "prior to" "pro" "pursuant + to" "qua" "rather than" "regardless of" "sans" "since" "so" "such as" "than" + "that of" "the" "through" "throughout" "thru" "thruout" "till" "to" "toward" "towards" + "under" "underneath" "until" "unto" "up" "upon" "v." "van" "versus" "via" "vis-à-vis" + "von" "vs." "where as" "with" "within" "without" "yet")) + +(defun citeproc-s-title-case (s) + "Return a title-cased version of string S." + (if (s-present-p s) + (with-temp-buffer + (insert s) + (goto-char 1) + (let ((first t) + after-colon) + (while (forward-word) + (let ((word (word-at-point))) + (cond ((and (not (or first after-colon)) + (member (downcase word) citeproc-s-english-stopwords) + ;; Don't downcase A before a period: + (or (not (string= word "A")) + (= (point) (point-max)) + (/= (char-after) ?.))) + (downcase-word -1)) + ((s-lowercase-p word) + (capitalize-word -1)))) + (when first (setq first nil)) + (when (< (point) (point-max)) + (setq after-colon (or (= (char-after) ?:) + (= (char-after) ?.)))))) + (buffer-string)) + s)) + +(defun citeproc-s-smart-quotes (s oq cq) + "Replace dumb quotes in string S with smart ones OQ and CQ. +OQ is the opening quote, CQ is the closing quote to use." + (with-temp-buffer + (insert s) + (goto-char 1) + (while (search-forward "\"" nil 1) + (let ((w-a-p (word-at-point))) + (delete-char -1) + (insert (if w-a-p oq cq)))) + (buffer-string))) + +(defun citeproc-s-replace-all-seq (s replacements) + "Make replacements in S according to REPLACEMENTS sequentially. +REPLACEMENTS is an alist with (FROM . TO) elements." + (let ((result s)) + (pcase-dolist (`(,from . ,to) replacements) + (setq result (string-replace from to result))) + result)) + +(defun citeproc-s-replace-all-sim (s regex replacements) + "Replace all matches of REGEX in S according to REPLACEMENTS simultaneously. +REPLACEMENTS is an alist with (FROM . TO) elements." + (replace-regexp-in-string regex + (lambda (match) (cdr (assoc-string match replacements))) + s t t)) + +(defun citeproc-s-smart-apostrophes (s) + "Replace dumb apostophes in string S with smart ones. +The replacement character used is the unicode character `modifier +letter apostrophe'." + (subst-char-in-string ?' ?ʼ (subst-char-in-string ?’ ?ʼ s t) t)) + +(defconst citeproc-s--cull-spaces-alist + '((" " . " ") (";;" . ";") ("..." . ".") (",," . ",") (".." . ".")) + "Alist describing replacements for space and punct culling.") + +(defconst citeproc-s--cull-spaces-alist-rx + (regexp-opt (mapcar #'car citeproc-s--cull-spaces-alist))) + +(defun citeproc-s-cull-spaces-puncts (s) + "Replace unnecessary characters with delete chars in string S." + (let ((result (citeproc-s-replace-all-seq s citeproc-s--cull-spaces-alist))) + (dolist (match-rep '(("\\([:;!?]\\):" . "\\1") + ("\\([:.;!?]\\)\\." . "\\1") + ("\\([:;!]\\)!" . "!") + ("\\([:;?]\\)\\?" . "?") + ("\\.\\([”’‹›«»]\\)\\." . ".\\1") + (",\\([”’‹›«»]\\)," . ",\\1")) + result) + (setq result (replace-regexp-in-string (car match-rep) + (cdr match-rep) + result))))) + +(provide 'citeproc-s) + +;;; citeproc-s.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-sort.el b/elpa/citeproc-20240722.1110/citeproc-sort.el new file mode 100644 index 00000000..4de98d9b --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-sort.el @@ -0,0 +1,192 @@ +;;; citeproc-sort.el --- cite and bibliography sorting -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to sort cites and bibliography items. + +;;; Code: + +(require 'subr-x) +(require 'cl-lib) +(require 'dash) +(require 's) + +(require 'citeproc-lib) +(require 'citeproc-s) +(require 'citeproc-rt) +(require 'citeproc-macro) +(require 'citeproc-proc) +(require 'citeproc-name) +(require 'citeproc-number) + +(defun citeproc--sort (_attrs _context &rest body) + "Placeholder function corresponding to the cs:sort element of CSL." + body) + +(defun citeproc-sort--name-var-key (var context) + "Return the sort-key for name-var VAR using CONTEXT. +VAR is a CSL name-var name as a symbol. The returned value is a +string containing a semicolon-separated list of all full names in +sort order." + (citeproc-rt-to-plain + (citeproc-rt-render-affixes + (citeproc-name--render-var var '((form . "long") (name-as-sort-order . "all") + (et-al-min . nil) (et-al-use-first . "0") + (delimiter . "; ")) + nil nil nil nil nil context)))) + +(defun citeproc-sort--date-as-key (d _context) + "Render D citeproc-date struct as a sort key." + (if d (let ((year (citeproc-date-year d)) + (month (or (citeproc-date-month d) 0)) + (day (or (citeproc-date-day d) 0))) + ;; We add 5000 as an offset to deal with sorting BC years properly + (concat (number-to-string (+ 5000 year)) + (citeproc-s-fill-left-to-len (number-to-string month) 2 ?0) + (citeproc-s-fill-left-to-len (number-to-string day) 2 ?0))) + "")) + +(defun citeproc-sort--date-var-key (var context) + "Return the sort-key for name-var VAR using CONTEXT. +VAR is a symbol." + (-let* (((d1 d2) (citeproc-var-value var context)) + (rendered-first (citeproc-sort--date-as-key d1 context))) + (if d2 + (concat rendered-first "–" (citeproc-sort--date-as-key d2 context)) + rendered-first))) + +(defun citeproc--key (attrs context &rest _body) + "Return a sort key corresponding to ATTRS and CONTEXT." + (-let (((&alist 'macro macro + 'variable var) + attrs) + (global-attrs (--filter (memq (car it) + '(names-min names-use-first names-use-last)) + attrs))) + (if var (let ((var-sym (intern var))) + (cond + ((memq var-sym citeproc--number-vars) + ;; OPTIMIZE: This is way too complicated to simply get a filled + ;; numeric value.. + (citeproc-s-fill-left-to-len + (citeproc-number-var-value + (citeproc-var-value var-sym context) var-sym 'numeric context) + 5)) + ((memq var-sym citeproc--date-vars) + (citeproc-sort--date-var-key var-sym context)) + ((memq var-sym citeproc--name-vars) + (citeproc-sort--name-var-key var-sym context)) + (t (citeproc-rt-to-plain (citeproc-var-value var-sym context))))) + (let ((new-context (citeproc-context--create + :vars (citeproc-context-vars context) + :macros (citeproc-context-macros context) + :terms (citeproc-context-terms context) + :date-text (citeproc-context-date-text context) + :date-numeric (citeproc-context-date-numeric context) + :opts (nconc global-attrs (citeproc-context-opts context)) + :mode (citeproc-context-mode context) + :render-mode 'sort + :render-year-suffix nil))) + (citeproc-macro-output-as-text macro new-context))))) + +(defun citeproc-sort--compare-keys (k1 k2 &optional desc) + "Return 1, 0 or -1 depending on the sort-order of keys K1 and K2. +If optional DESC is non-nil then reverse the comparison for +descending sort." + (cond ((string-collate-equalp k1 k2) 0) + ((s-blank? k1) -1) + ((s-blank? k2) 1) + (t (* (if (string-collate-lessp k1 k2) 1 -1) + (if desc -1 1))))) + +(defun citeproc-sort--compare-keylists (k1 k2 sort-orders) + "Whether keylist K1 precedes keylist K2 in the sort order. +SORT-ORDERS is a list of sort orders to use (see the bib- and +cite-sort-orders slots of `citeproc-style' for details)." + (citeproc-lib-lex-compare k1 k2 #'citeproc-sort--compare-keys sort-orders)) + +(defun citeproc-sort--render-keys (style var-alist mode) + "Render the sort keys of an item with STYLE and VAR-ALIST. +MODE is either `cite' or `bib'." + (let ((context (citeproc-context-create var-alist style mode 'sort)) + (sort (cl-ecase mode + (cite (citeproc-style-cite-sort style)) + (bib (citeproc-style-bib-sort style))))) + (if sort (funcall sort context) nil))) + +(defun citeproc-itd-update-sortkey (itd style) + "Update the sort key of itemdata ITD for STYLE." + (setf (citeproc-itemdata-sort-key itd) + (citeproc-sort--render-keys style (citeproc-itemdata-varvals itd) 'bib))) + +(defun citeproc-proc-update-sortkeys (proc) + "Update all sort keys of the itemdata in PROC." + (let ((style (citeproc-proc-style proc)) + (itds (citeproc-proc-itemdata proc))) + (maphash (lambda (_id itd) + (citeproc-itd-update-sortkey itd style)) + itds))) + +(defun citeproc-sort-itds-on-citnum (itds) + "Sort itemdata struct list ITDS according to citation number." + (sort itds + (lambda (x y) + (< (string-to-number (citeproc-itd-getvar x 'citation-number)) + (string-to-number (citeproc-itd-getvar y 'citation-number)))))) + +(defun citeproc-sort-itds-on-subbib (itd1 itd2) + "Sort itemdata structs ITD1 ITD2 according to subbib order." + (let ((idx1 (car (citeproc-itemdata-subbib-nos itd1))) + (idx2 (car (citeproc-itemdata-subbib-nos itd2)))) + (and idx1 + (or (null idx2) (< idx1 idx2))))) + +(defun citeproc-sort-itds (itds sort-orders) + "Sort the itemdata struct list ITDS according to SORT-ORDERS." + (sort itds + (lambda (x y) + (citeproc-sort--compare-keylists (citeproc-itemdata-sort-key x) + (citeproc-itemdata-sort-key y) + sort-orders)))) + +(defun citeproc-proc-sort-itds (proc) + "Sort the itemdata in PROC." + (let ((is-sorted-bib (citeproc-style-bib-sort (citeproc-proc-style proc))) + (is-filtered (citeproc-proc-filtered-bib-p proc))) + (when (or is-sorted-bib is-filtered) + (let* ((itds (citeproc-sort-itds-on-citnum + (hash-table-values (citeproc-proc-itemdata proc))))) + (when is-sorted-bib + (let ((sort-orders (citeproc-style-bib-sort-orders + (citeproc-proc-style proc)))) + (setq itds (citeproc-sort-itds itds sort-orders)))) + ;; Additionally sort according to subbibliographies if there are filters. + (when is-filtered + (setq itds (sort itds #'citeproc-sort-itds-on-subbib))) + ;; Set the CSL citation-number field according to the sort order. + (--each-indexed itds + (citeproc-itd-setvar it 'citation-number + (number-to-string (1+ it-index)))))))) + +(provide 'citeproc-sort) + +;;; citeproc-sort.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-style.el b/elpa/citeproc-20240722.1110/citeproc-style.el new file mode 100644 index 00000000..32f6c30f --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-style.el @@ -0,0 +1,354 @@ +;; citeproc-style.el --- CSL style structure and related functions -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Structure type and functions for constructing and accessing CSL style +;; objects. + +;;; Code: + +(require 'subr-x) +(require 'let-alist) +(require 'dash) +(require 'cl-lib) +(require 's) + +(require 'citeproc-lib) +(require 'citeproc-locale) + +(cl-defstruct (citeproc-style (:constructor citeproc-style--create)) + "A struct representing a parsed and localized CSL style. +CATEGORY is the style's category as a string, +INFO is the style's general info (currently simply the + corresponding fragment of the parsed xml), +OPTS, BIB-OPTS, CITE-OPTS and LOCALE-OPTS are alists of general + and bibliography-, cite- and locale-specific CSL options, +BIB-SORT, BIB-LAYOUT, CITE-SORT and CITE-LAYOUT are anonymous + functions for calculating sort-keys and rendering, +BIB-SORT-ORDERS and CITE-SORT-ORDERS are the lists of sort orders + for bibliography and cite sort (the value is a list containg t + or nil as its n-th element depending on whether the sort for on + the n-th key should be in ascending or desending order, +CITE-LAYOUT-ATTRS contains the attributes of the citation layout + as an alist, +DATE-TEXT and DATE-NUMERIC are the style's date formats, +LOCALE contains the locale to be used or nil if not set, +MACROS is an alist with macro names as keys and corresponding + anonymous rendering functions, +TERMS is the style's parsed term-list, +USES-YS-VAR is non-nil iff the style uses the YEAR-SUFFIX + CSL-variable." + category info opts bib-opts bib-sort bib-sort-orders + bib-layout cite-opts cite-sort cite-sort-orders + cite-layout cite-layout-attrs locale-opts macros terms + uses-ys-var date-text date-numeric locale) + +(defun citeproc-style-parse (style) + "Return the parsed representation of csl STYLE. +STYLE is either a path to a style file or a style as a string. +Returns a (YEAR-SUFF-P . PARSED-STYLE) cons cell. YEAR-SUFF-P is +non-nil if the style uses the `year-suffix' csl var; PARSED-STYLE +is the parsed form of the xml STYLE-FILE." + (let ((xml-input (s-matches-p " ?<" style))) + (with-temp-buffer + (let ((case-fold-search t)) + (if xml-input (insert style) + (insert-file-contents style)) + (goto-char 1) + (cons (re-search-forward "variable=\"year-suffix\"" nil t) + (citeproc-lib-remove-xml-comments + (libxml-parse-xml-region (point-min) (point-max)))))))) + +;; TODO: Parse and store info in a more structured and sensible form. Also, +;; currently the first in-style locale is loaded that is compatible with the +;; locale to be used. In theory, there may be more than one compatible in-style +;; locales that should be merged in an order reflecting their closeness to the +;; requested locale. +(defun citeproc-create-style-from-locale (parsed-style year-suffix locale) + "Create a citation style from parsed xml style PARSED-STYLE. +YEAR-SUFFIX specifies whether the style explicitly uses the +`year-suffix' csl variable. LOCALE is the locale for which +in-style locale information will be loaded (if available)." + (let* ((style (citeproc-style--create)) + (style-opts (cadr parsed-style)) + locale-loaded) + (setf (citeproc-style-opts style) style-opts + (citeproc-style-uses-ys-var style) year-suffix + (citeproc-style-locale style) + (or locale (alist-get 'default-locale style-opts))) + (--each (cddr parsed-style) + (pcase (car it) + ('info + (let* ((info-lst (cddr it)) + (category-info (cl-find-if + (lambda (x) (and (eq 'category (car x)) + (eq 'citation-format (caaadr x)))) + info-lst)) + (category (cdaadr category-info))) + (setf (citeproc-style-category style) category))) + ('locale + (let ((lang (alist-get 'lang (cadr it)))) + (when (and (citeproc-locale--compatible-p lang locale) + (not locale-loaded)) + (citeproc-style--update-locale style it) + (setq locale-loaded t)))) + ('citation + (citeproc-style--update-cite-info style it)) + ('bibliography + (citeproc-style--update-bib-info style it)) + ('macro + (citeproc-style--update-macros style it)))) + style)) + +(defun citeproc-style--parse-layout-and-sort-frag (frag) + "Parse a citation or bibliography style xml FRAG. +Return an alist with keys `layout', `opts', `layout-attrs', `sort' +and `sort-orders'." + (let* ((opts (cadr frag)) + (sort-p (eq (cl-caaddr frag) 'sort)) + (layout (citeproc-style--transform-xmltree + (elt frag (if sort-p 3 2)))) + (layout-attrs (cl-cadadr (cl-caddr layout))) + sort sort-orders) + (when sort-p + (let* ((sort-frag (cl-caddr frag))) + (setq sort (citeproc-style--transform-xmltree sort-frag) + sort-orders (--map (not (string= "descending" (alist-get 'sort (cadr it)))) + (cddr sort-frag))))) + `((opts . ,opts) (layout . ,layout) (layout-attrs . ,layout-attrs) + (sort . ,sort) (sort-orders . ,sort-orders)))) + +(defun citeproc-style--update-cite-info (style frag) + "Update the cite info of STYLE on the basis of its parsed FRAG." + (let-alist (citeproc-style--parse-layout-and-sort-frag frag) + (setf (citeproc-style-cite-opts style) .opts + (citeproc-style-cite-layout style) .layout + (citeproc-style-cite-layout-attrs style) .layout-attrs + (citeproc-style-cite-sort style) .sort + (citeproc-style-cite-sort-orders style) .sort-orders))) + +(defun citeproc-style--update-bib-info (style frag) + "Update the bib info of STYLE on the basis of its parsed FRAG." + (let-alist (citeproc-style--parse-layout-and-sort-frag frag) + (setf (citeproc-style-bib-opts style) .opts + (citeproc-style-bib-layout style) .layout + (citeproc-style-bib-sort style) .sort + (citeproc-style-bib-sort-orders style) .sort-orders))) + +(defun citeproc-style--update-macros (style frag) + "Update the macro info of STYLE on the basis of its parsed FRAG." + (let ((name (cl-cdaadr frag))) + (setf (car frag) 'macro) + (setf (cadr frag) nil) + (push (cons name (citeproc-style--transform-xmltree frag)) + (citeproc-style-macros style)))) + +(defun citeproc-style--update-locale (style frag) + "Update locale info in STYLE using xml fragment FRAG. +FRAG should be a parsed locale element from a style or a locale." + (--each (cddr frag) + (pcase (car it) + ('style-options (setf (citeproc-style-locale-opts style) + (-concat (citeproc-style-locale-opts style) + (cadr it)))) + ('date + (citeproc-style--update-locale-date style it)) + ('terms + (let ((parsed-terms (citeproc-locale-termlist-from-xml-frag (cddr it)))) + (setf (citeproc-style-terms style) + (if (citeproc-style-terms style) + (citeproc-term-list-update parsed-terms (citeproc-style-terms style)) + parsed-terms))))))) + +(defun citeproc-style--update-locale-date (style frag) + "Update date info in STYLE using xml fragment FRAG. +FRAG should be a parsed locale element from a style or a locale." + (let* ((date-attrs (cadr frag)) + (form (alist-get 'form date-attrs)) + (date-format (cons date-attrs + (citeproc-lib-named-parts-to-alist frag)))) + (if (string= form "text") + (unless (citeproc-style-date-text style) + (setf (citeproc-style-date-text style) date-format)) + (unless (citeproc-style-date-numeric style) + (setf (citeproc-style-date-numeric style) date-format))))) + +(defconst citeproc-style--opt-defaults + '((cite-opts near-note-distance "5") + (locale-opts punctuation-in-quote "false") + (locale-opts limit-day-ordinals-to-day-1 "false") + (bib-opts hanging-indent "false") + (bib-opts line-spacing "1") + (bib-opts entry-spacing "1") + (opts initialize-with-hyphen "true") + (opts demote-non-dropping-particle "display-and-sort")) + "Global style options. +Specified as a list of (STYLE-SLOT OPTION-NAME OPTION-DEFAULT) +lists. + +Note: Collapse-related options are not specified here since their +default settings are interdependent.") + +(defun citeproc-style--set-opt (style opt-slot opt value) + "Set OPT in STYLE's OPT-SLOT to VALUE." + (setf (cl-struct-slot-value 'citeproc-style opt-slot style) + (cons (cons opt value) + (cl-struct-slot-value 'citeproc-style opt-slot style)))) + +(defun citeproc-style--set-opt-defaults (style) + "Set missing options of STYLE to their default values." + (cl-loop + for (slot option value) in citeproc-style--opt-defaults do + (let ((slot-value (cl-struct-slot-value 'citeproc-style slot style))) + (unless (alist-get option slot-value) + (setf (cl-struct-slot-value 'citeproc-style slot style) + (cons (cons option value) slot-value))))) + (let* ((cite-opts (citeproc-style-cite-opts style)) + (collapse (alist-get 'collapse cite-opts))) + (when (and collapse (not (string= collapse "citation-number"))) + (let ((cite-layout-dl + (alist-get 'delimiter (citeproc-style-cite-layout-attrs style))) + (cite-group-dl + (alist-get 'cite-group-delimiter cite-opts))) + (unless cite-group-dl + (citeproc-style--set-opt style 'cite-opts 'cite-group-delimiter ", ")) + (unless (alist-get 'after-collapse-delimiter cite-opts) + (citeproc-style--set-opt + style 'cite-opts 'after-collapse-delimiter cite-layout-dl)) + (when (and (member collapse '("year-suffix" "year-suffix-ranged")) + (null (alist-get 'year-suffix-delimiter cite-opts))) + (citeproc-style--set-opt + style 'cite-opts 'year-suffix-delimiter cite-layout-dl)))))) + +(defun citeproc-style--transform-xmltree (tree) + "Transform parsed csl xml fragment TREE into a lambda." + `(lambda (context) ,(citeproc-style--transform-xmltree-1 tree))) + +(defun citeproc-style--transform-xmltree-1 (tree) + "Transform parsed xml fragment TREE into an eval-able form. +Symbols in car position are prefixed with `citeproc--' and the +symbol `context' is inserted everywhere after the second (attrs) +position and before the (possibly empty) body." + (pcase tree + ((pred atom) tree) + (`(names . ,_) (citeproc-style--transform-names tree)) + (_ + `(,(intern (concat "citeproc--" (symbol-name (car tree)))) + ,(list 'quote (cadr tree)) + context + ,@(mapcar #'citeproc-style--transform-xmltree-1 (cddr tree)))))) + +(defun citeproc-style--transform-names (frag) + "Transform the content of a cs:names CSL element xml FRAG." + (let* ((names-attrs (cadr frag)) + (body (-remove #'stringp (cddr frag))) + (vars (alist-get 'variable names-attrs)) + substs name-attrs name-parts et-al-attrs + is-label label-attrs label-before-names) + (--each body + (pcase (car it) + ('name + (setq name-attrs (cadr it) + name-parts (citeproc-lib-named-parts-to-alist it) + label-before-names t)) + ('et-al + (setq et-al-attrs (cadr it))) + ('label + (setq is-label t + label-attrs (cadr it) + label-before-names nil)) + ('substitute + (setq substs + (mapcar + (lambda (x) + (if (eq (car x) 'names) + `(citeproc-name-render-vars + ,(alist-get 'variable (cadr x)) + names-attrs name-attrs name-parts et-al-attrs + is-label label-before-names label-attrs context) + (citeproc-style--transform-xmltree-1 x))) + (cddr it)))))) + `(if (citeproc-var-value 'suppress-author context) (cons nil 'empty-vars) + (let* ((names-attrs ',names-attrs) + (name-attrs ',name-attrs) + (count (string= (alist-get 'form name-attrs) "count")) + (et-al-attrs ',et-al-attrs) + (name-parts ',name-parts) + (label-attrs ',label-attrs) + (is-label ,is-label) + (label-before-names ,label-before-names) + (val (citeproc-name-render-vars + ,vars names-attrs name-attrs name-parts et-al-attrs + is-label label-before-names label-attrs context)) + (result (if (car val) + val + (-if-let ((cont . type) (--first (car it) + (list ,@substs))) + (cons (cons (list '(subst . t)) (list cont)) type) + (cons nil 'empty-vars)))) + (final (if count + (let* ((number (citeproc-rt-count-names (car result))) + (str (if (= 0 number) "" (number-to-string number)))) + (cons str (cdr result))) + result))) + ;; Handle `author' citation mode by stopping if needed + (citeproc-context-maybe-stop-rendering 'names context final))))) + +(defun citeproc-style-cite-note (style) + "Return whether csl STYLE is a note style." + (string= (citeproc-style-category style) "note")) + +(defun citeproc-style-cite-superscript-p (style) + "Return whether csl STYLE has a superscript citaton layout." + (string= (alist-get 'vertical-align (citeproc-style-cite-layout-attrs style)) + "sup")) + +(defun citeproc-style-global-opts (style layout) + "Return the global opts in STYLE for LAYOUT. +LAYOUT is either `bib' or `cite'." + (-concat (cl-ecase layout + (bib (citeproc-style-bib-opts style)) + (cite (citeproc-style-cite-opts style))) + (citeproc-style-opts style))) + +(defun citeproc-style-bib-opts-to-formatting-params (bib-opts) + "Convert BIB-OPTS to a formatting parameters alist." + (let ((result + (cl-loop + for (opt . val) in bib-opts + if (memq opt + '(hanging-indent line-spacing entry-spacing second-field-align)) + collect (cons opt + (pcase val + ("true" t) + ("false" nil) + ("flush" 'flush) + ("margin" 'margin) + (_ (string-to-number val))))))) + (if (alist-get 'second-field-align result) + result + (cons (cons 'second-field-align nil) + result)))) + +(provide 'citeproc-style) + +;;; citeproc-style.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-subbibs.el b/elpa/citeproc-20240722.1110/citeproc-subbibs.el new file mode 100644 index 00000000..1109081f --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-subbibs.el @@ -0,0 +1,89 @@ +;;; citeproc-subbibs.el --- support for subbibliographies -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2022 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Support for generating subbibliographies based on filtering items. + +;;; Code: + +(require 'subr-x) +(require 'compat) +(require 'dash) + +(require 'citeproc-proc) +(require 'citeproc-itemdata) + +(defun citeproc-sb--match-p (vv filter) + "Return whether var-vals alist VV matches all conditions in FILTER. +FILTER should be an alist containing symbol keys and string +values, each pair describing an atomic condition to be +satisified. For a list and description of the supported keys +see the documentation of `citeproc-add-subbib-filters'." + (let* ((csl-type (alist-get 'type vv)) + (type (or (alist-get 'blt-type vv) csl-type)) + (keyword (alist-get 'keyword vv)) + (keywords (and keyword (mapcar #'string-clean-whitespace + (split-string keyword "[,;]" t))))) + (--every-p + (pcase it + (`(type . ,key) (string= type key)) + (`(nottype . ,key) (not (string= type key))) + (`(keyword . ,key) (member key keywords)) + (`(notkeyword . ,key) (not (member key keywords))) + (`(filter . ,key) (funcall (intern key) vv)) + (`(csltype . ,key) (string= csl-type key)) + (`(notcsltype . ,key) (not (string= csl-type key))) + (`(,key . ,_) (error "Unsupported Citeproc filter keyword `%s'" key))) + filter))) + +(defun citeproc-sb-add-subbib-info (proc) + "Add subbibliography information to the items in PROC." + (when (citeproc-proc-filtered-bib-p proc) + (let ((filters (citeproc-proc-bib-filters proc))) + (maphash + (lambda (_ itemdata) + (let* ((varvals (citeproc-itemdata-varvals itemdata)) + (subbib-nos + (-non-nil + (--map-indexed + (when (citeproc-sb--match-p varvals it) it-index) + filters)))) + (setf (citeproc-itemdata-subbib-nos itemdata) subbib-nos))) + (citeproc-proc-itemdata proc))))) + +(defun citeproc-sb-prune-unrendered (proc) + "Remove all itemdata about unrendered items from PROC. +An item is unrendered if +- there are subbibfilters but none of them matches it, and +- it is not cited." + (when (citeproc-proc-filtered-bib-p proc) + (let ((itemdata (citeproc-proc-itemdata proc))) + (maphash + (lambda (id data) + (when (and (citeproc-itemdata-uncited data) + (null (citeproc-itemdata-subbib-nos data))) + (remhash id itemdata))) + itemdata)))) + +(provide 'citeproc-subbibs) + +;;; citeproc-subbibs.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-term.el b/elpa/citeproc-20240722.1110/citeproc-term.el new file mode 100644 index 00000000..ce9bbaf0 --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-term.el @@ -0,0 +1,113 @@ +;;; citeproc-term.el --- functions for term localization -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions for localizing the terms of a CSL style according to a locale. + +;;; Code: + +(require 'dash) +(require 'cl-lib) +(require 'let-alist) + +(require 'citeproc-lib) +(require 'citeproc-s) + +(cl-defstruct (citeproc-term (:constructor citeproc-term--create)) + "A struct representing a localized term." + (name nil) (form nil) (number nil) (gender nil) (gender-form nil) + (match nil) (text nil)) + +(defun citeproc-term--compare (t1 t2) + "Compare terms T1 and T2. +The comparison is based on the term fields except the last one, +and relies on the alphabetical ordering of fields' string +content (see the function `citeproc-lib-s-content'). Return 1, -1 +or 0 iff T1 precedes, succeeds or is equal according to the +ordering." + (cond ((not t2) 1) + ((not t1) -1) + (t (let ((idx 1) + (result 0)) + (while (and (= result 0) (< idx 7)) + (let ((s1 (citeproc-s-content (aref t1 idx))) + (s2 (citeproc-s-content (aref t2 idx)))) + (cond ((string< s1 s2) (setq result 1)) + ((string> s1 s2) (setq result -1)))) + (cl-incf idx)) result)))) + +(defun citeproc-term-list--sort (tl) + "Sort termlist TL in place using `citeproc-term--compare'." + (cl-sort tl (lambda (x y) (> (citeproc-term--compare x y) -1)))) + +(defun citeproc-term-list-update (tl1 tl2 &optional sorted-input) + "Return a term list which is TL1 updated with term list TL2. +TL1 and TL2 are list of citeproc-term structs. The order of terms +in the returned term list is undetermined. If the optional +SORTED-INPUT is non-nil then the term lists are supposed to be +already sorted according to `citeproc-term--compare', otherwise +they are sorted in-place." + (let (result) + (unless sorted-input + (setq tl1 (citeproc-term-list--sort tl1) + tl2 (citeproc-term-list--sort tl2))) + (while (or tl1 tl2) + (let* ((t1 (car tl1)) + (t2 (car tl2)) + (cmp (citeproc-term--compare t1 t2))) + (cond ((= cmp 1) (push t1 result) (pop tl1)) + ((= cmp -1) (push t2 result) (pop tl2)) + (t (push t2 result) (pop tl1) (pop tl2))))) + result)) + +(defun citeproc-term--from-xml-frag (frag) + "Transform xml FRAG representing a term into a citeproc-term struct." + (let-alist (car frag) + (-let* ((.form (or .form "long")) + (term (citeproc-term--create + :name .name + :form (citeproc-lib-intern .form) + :gender (citeproc-lib-intern .gender) + :match (citeproc-lib-intern .match) + :gender-form (citeproc-lib-intern .gender-form)))) + (if (= (length frag) 2) + (progn + (setf (citeproc-term-text term) (cadr frag)) + (list term)) + (setf (citeproc-term-text term) (cl-caddr (cadr frag))) + (setf (citeproc-term-number term) 'single) + (let ((multi-term (copy-citeproc-term term))) + (setf (citeproc-term-text multi-term) (cl-caddr (cl-caddr frag))) + (setf (citeproc-term-number multi-term) 'multiple) + (list term multi-term)))))) + +(defun citeproc-term-text-from-terms (term terms) + "Return the first text associated with TERM in TERMS. +Return nil if TERM is not in TERMS." + (-if-let (match (--first (string= term (citeproc-term-name it)) + terms)) + (citeproc-term-text match) + nil)) + +(provide 'citeproc-term) + +;;; citeproc-term.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc-test-human.el b/elpa/citeproc-20240722.1110/citeproc-test-human.el new file mode 100644 index 00000000..202e5e1f --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc-test-human.el @@ -0,0 +1,207 @@ +;; citeproc-test-human.el --- support tests in CSL suite format -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2021 András Simonyi + +;; Author: András Simonyi + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Functions to create ERT tests from tests in CSL test suite format. The +;; official tests can be found at +;; . + +;;; Code: + +(require 'f) +(require 's) +(require 'json) +(require 'ert) +(require 'string-inflection) + +(require 'citeproc) + +(defvar citeproc-test-human--locale-dir "./test/locales") + +(defun citeproc-test-human--parse-testfile (file) + "Return a parsed form of CSL test FILE." + (let (result + (json-array-type 'list) + (json-key-type 'symbol)) + (with-temp-buffer + (insert-file-contents file) + (goto-char 1) + (setq result (list (cons 'YEAR-SUFF + (re-search-forward "variable=\"year-suffix\"" nil t)))) + (goto-char 1) + (while (re-search-forward ">>=+ \\{1,2\\}\\([[:graph:]]+\\) =+>>" nil t) + (let ((section (intern (buffer-substring (nth 2 (match-data)) + (nth 3 (match-data))))) + (start (1+ (point))) + end) + (re-search-forward "<<=" nil t) + (setq end (- (car (match-data)) 1)) + (push (cons section (pcase section + ('OUTPUT-FORMAT + (intern (buffer-substring-no-properties start end))) + ('CSL (buffer-substring-no-properties start end)) + ((or 'INPUT 'CITATIONS 'CITATION-ITEMS) + (goto-char (- start 1)) (json-read)) + (_ (buffer-substring start end)))) + result)))) + result)) + +(defun citeproc-test-human--create-getter (items) + "Return a getter function for ITEMS. +ITEMS is the parsed representation of the `INPUT' section of a +CSL test." + (lambda (itemids) + (let (result) + (dolist (item items result) + (let ((id (citeproc-s-from-num-or-s (alist-get 'id item)))) + (when (member id itemids) + (push (cons id item) result))))))) + +(defun citeproc-test-human--proc-from-style (style parsed-input) + "Create a processor from STYLE and PARSED-INPUT." + (citeproc-create style + (citeproc-test-human--create-getter parsed-input) + (citeproc-locale-getter-from-dir citeproc-test-human--locale-dir))) + +(defun citeproc-test-human--proc-from-testfile (file) + "Create an (itemless) processor from a test FILE." + (let ((style-string (alist-get 'CSL (citeproc-test-human--parse-testfile file))) + (locale-getter (citeproc-locale-getter-from-dir citeproc-test-human--locale-dir))) + (citeproc-create style-string nil locale-getter))) + +(defun citeproc-test-human--parse-citation (ct-desc &optional cites-only) + "Parse test citations description CT-DESC. +Return a list of citation structures. If CITES-ONLY is non-nil +then the input is list of cites." + (if cites-only + (citeproc-citation-create + :cites (-map #'citeproc-test-human--normalize-cite ct-desc)) + (let ((citation-info (car ct-desc))) + (let-alist (alist-get 'properties citation-info) + (citeproc-citation-create + :cites (-map #'citeproc-test-human--normalize-cite + (alist-get 'citationItems citation-info)) + :note-index .noteIndex + :mode (citeproc-lib-intern .mode) + :capitalize-first .capitalize-first + :suppress-affixes .suppress-affixes + :ignore-et-al .ignore-et-al))))) + +(defun citeproc-test-human--normalize-cite (cite) + "Normalize a test CITE." + (--map (let ((val (cdr it))) + (if (numberp val) (cons (car it) (number-to-string val)) it)) + cite)) + +(defun citeproc-test-human--run-parsed (parsed) + "Run the parsed CSL test PARSED. +Return the resulting output." + (-let* (((&alist 'CSL style + 'INPUT input + 'MODE mode + 'CITATION-ITEMS citation-items + 'CITATIONS citations + 'OUTPUT-FORMAT output-format) + parsed) + (output-format (or output-format 'csl-test)) + (proc (citeproc-test-human--proc-from-style style input))) + (--each input + (citeproc-proc-put-item-by-id proc + (citeproc-s-from-num-or-s (alist-get 'id it)))) + (when (string= mode "citation") + (cond + (citation-items + (citeproc-append-citations (--map (citeproc-test-human--parse-citation it t) + citation-items) + proc)) + (citations + (citeproc-append-citations (mapcar #'citeproc-test-human--parse-citation citations) + proc)) + (t (citeproc-append-citations (list (citeproc-test-human--parse-citation input t)) + proc)))) + (let ((output (if (string= mode "citation") + (citeproc-render-citations proc output-format + (when (eq 'csl-test output-format) + 'no-links)) + (car (citeproc-render-bib proc output-format 'no-links))))) + (if (string= mode "citation") (s-join "\n" output) output)))) + +(defun citeproc-test-human--expected-from-parsed (parsed) + "Return the expected output of parsed CSL test PARSED." + (let ((expected (alist-get 'RESULT parsed))) + (if (or (string= (s-left 5 expected) "..[0]") + (string= (s-left 5 expected) ">>[0]")) + (s-join "\n" (--map (substring it 6) + (split-string expected "\n"))) + expected))) + +(defun citeproc-test-human-create-from-file (file expected-fails &optional name-prefix) + "Create an ERT test from a CSL test FILE. +If optional NAME-PREFIX is non-nil then it is added the name of +the created test after the obligatory `citeproc'." + (let* ((parsed (citeproc-test-human--parse-testfile file)) + (expected (citeproc-test-human--expected-from-parsed parsed)) + (file-name (f-filename file)) + (test-name (intern + (concat "citeproc-" + (if name-prefix (concat name-prefix "-") "") + (string-inflection-kebab-case-function + (substring file-name 0 -4))))) + (expected-fail (memq test-name expected-fails))) + (eval `(ert-deftest ,test-name () + :expected-result ,(if expected-fail :failed :passed) + (let ((citeproc-disambiguation-cite-pos 'subsequent)) + (should (string= + ,expected + (citeproc-test-human--run-parsed ',parsed)))))))) + +(defun citeproc-test-human---read-expected-fails (expected-fails-file) + "Read the list of tests expected to fail from EXPECTED-FAILS-FILE." + (let* ((list-as-str (with-temp-buffer + (insert-file-contents expected-fails-file) + (buffer-string))) + (split (split-string list-as-str "\n"))) + (--map (intern it) (butlast split)))) + +(defun citeproc-test-human-create-from-dir (dir &optional + expected-fails-file name-prefix) + "Create all CSL tests from DIR. +Each file in DIR having the `txt' extension is read as a +human-readable CSL test, and a corresponding ERT test is created. +The created test's name will be constructed by prefixing the +test's filename (without the extension) with `citeproc-'. If the +optional EXPECTED-FAILS-FILE is non-nil then read that file as a +list of tests whose failure is expected. If optional NAME-PREFIX +is non-nil then it is added the names of the created tests after +the obligatory `citeproc'. The file should contain one test-name +per line (together with the `citeproc-' prefix)." + (let ((expected-fails + (if expected-fails-file + (citeproc-test-human---read-expected-fails expected-fails-file) + nil))) + (dolist (test-file (f-glob (concat dir "/*.txt"))) + (citeproc-test-human-create-from-file test-file expected-fails + name-prefix)))) + +(provide 'citeproc-test-human) + +;;; citeproc-test-human.el ends here diff --git a/elpa/citeproc-20240722.1110/citeproc.el b/elpa/citeproc-20240722.1110/citeproc.el new file mode 100644 index 00000000..c8648b4f --- /dev/null +++ b/elpa/citeproc-20240722.1110/citeproc.el @@ -0,0 +1,324 @@ +;;; citeproc.el --- A CSL 1.0.2 Citation Processor -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2024 András Simonyi + +;; Author: András Simonyi +;; Maintainer: András Simonyi +;; URL: https://github.com/andras-simonyi/citeproc-el +;; Keywords: bib +;; Package-Requires: ((emacs "26") (dash "2.13.0") (s "1.12.0") (f "0.18.0") (queue "0.2") (string-inflection "1.0") (org "9") (parsebib "2.4")(compat "28.1")) +;; Package-Version: 20240722.1110 +;; Package-Revision: 54184baaff55 + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; citeproc-el is a library for rendering citations and bibliographies in styles +;; described in the Citation Style Language (CSL). + +;;; Code: + +(require 'dash) +(require 'queue) + +(require 'citeproc-rt) +(require 'citeproc-locale) +(require 'citeproc-style) +(require 'citeproc-choose) +(require 'citeproc-generic-elements) +(require 'citeproc-context) +(require 'citeproc-itemdata) +(require 'citeproc-proc) +(require 'citeproc-cite) +(require 'citeproc-sort) +(require 'citeproc-formatters) +(require 'citeproc-itemgetters) +(require 'citeproc-subbibs) + +;;; Public API + +(defun citeproc-create (style it-getter loc-getter &optional loc force-loc) + "Return a CSL processor for a given STYLE, IT-GETTER and LOC-GETTER. +STYLE is either a path to a CSL style file or a CSL style as a + string. +IT-GETTER is an item-getter function that takes a list of itemid + strings as its sole argument and returns an alist in which the + given itemids are the keys and the values are the parsed csl + json descriptions of the corresponding bibliography items (keys + are symbols, arrays and hashes should be represented as lists + and alists, respecively). +LOC-GETTER is a function that takes a locale string (e.g. + \"en-GB\") as an argument and returns a corresponding parsed + CSL locale (as parsed by Emacs's `libxml-parse-xml-region'). +Optional LOC is the locale to use if the style doesn't specify a + default one. Defaults to \"en-US\". +If optional FORCE-LOC is non-nil then use locale LOC even if + STYLE specifies a different one as default. Defaults to nil." + (let ((style (citeproc-create-style style loc-getter loc force-loc)) + (names (make-hash-table :test 'equal)) + (itemdata (make-hash-table :test 'equal)) + (citations (make-queue))) + (citeproc-proc--create :style style :getter it-getter :names names + :itemdata itemdata :citations citations :finalized t))) + +(defun citeproc-append-citations (citations proc) + "Append CITATIONS to the list of citations in PROC. +CITATIONS is a list of `citeproc-citation' structures." + (let ((itemdata (citeproc-proc-itemdata proc)) + ids) + ;; Collect new itemids + (dolist (citation citations) + (dolist (cite (citeproc-citation-cites citation)) + (push (alist-get 'id cite) ids))) + (let* ((uniq-ids (delete-dups (nreverse ids))) ; reverse pushed ids + (new-ids (--remove (gethash it itemdata) uniq-ids))) + ;; Add all new items in one pass + (citeproc-proc-put-items-by-id proc new-ids) + ;; Internalize the cites dealing with locator-extra if present, add itemdata to + ;; the cite structs and add them to the cite queue. + (dolist (citation citations) + (setf (citeproc-citation-cites citation) + (--map (cons (cons 'itd (gethash (alist-get 'id it) itemdata)) + (citeproc-cite--internalize-locator it)) + (citeproc-citation-cites citation))) + (queue-append (citeproc-proc-citations proc) citation)) + (setf (citeproc-proc-finalized proc) nil)))) + +(defun citeproc-add-uncited (itemids proc) + "Add uncited bib items with ITEMIDS to PROC. +As an extension, an itemid can be the string \"*\" which has the +effect of adding all items available in the itemgetter." + ;; We simply store the added ids here, real processing is performed when the + ;; processor is finalized. + (push itemids (citeproc-proc-uncited proc)) + (setf (citeproc-proc-finalized proc) nil)) + +(defun citeproc-add-subbib-filters (filters proc) + "Add sub-bibliography FILTERS to PROC. +FILTERS should be a list of alists containing symbol keys and +string values, each pair describing an atomic condition to be +satisified by the printed entries. The following keys are +supported: +- `type': print only entries of the given type. Type is the + bib(la)tex entry type if available, otherwise the CSL type is + used as fallback; +- `nottype': print only entries not of the given type. Type is + the bib(la)tex entry type if available, otherwise the CSL type + is used as fallback; +- `csltype', `notcsltype': same as `type' and `nottype' but uses + the entries' CSL type even if the bib(la)tex type is also + available; +- `keyword': print only entries with the given keyword; +- `notkeyword': print only entries without the given keyword; +- `filter': print only entries for which the function named by + the key returns a non-nil value." + (setf (citeproc-proc-bib-filters proc) filters + (citeproc-proc-finalized proc) nil)) + +(defun citeproc-render-citations (proc format &optional internal-links) + "Render all citations in PROC in the given FORMAT. +Return a list of formatted citations. + If the optional INTERNAL-LINKS is `bib-links' then link cites +to the bibliography regardless of the style type, if `no-links' +then don't add internal links, if nil or `auto' then add internal +links based on the style type (cite-cite links for note styles +and cite-bib links else). For legacy reasons, any other value is +treated as `no-links'." + (citeproc-proc-finalize proc) + (--map (citeproc-citation--render-formatted-citation it proc format internal-links) + (queue-head (citeproc-proc-citations proc)))) + +(defun citeproc-render-bib (proc format &optional internal-links + no-external-links bib-formatter-fun) + "Render a bibliography of items in PROC in FORMAT. +For the optional INTERNAL-LINKS argument see +`citeproc-render-citations'. If the optional NO-EXTERNAL-LINKS is +non-nil then don't generate external links. If the optional +BIB-FORMATTER-FUN is given then it will be used to join the +bibliography items instead of the content of the chosen +formatter's `bib' slot (see `citeproc-formatter' for details). + +Returns an error message string if the style of PROC doesn't +contain a bibliography section. Otherwise it returns +a (FORMATTED-BIBLIOGRAPHY . FORMATTING-PARAMETERS) cons cell, +where FORMATTED-BIBLIOGRAPHY is either a single bibliography or a +list of sub-bibliograhies if filters were added to the processor, +and FORMATTING-PARAMETERS is an alist containing the following +formatting parameters keyed to the parameter names as symbols: +- `max-offset' (integer): The width of the widest first field in + the bibliography, measured in characters. +- `line-spacing' (integer): Vertical line distance specified as a + multiple of standard line height. +- `entry-spacing' (integer): Vertical distance between + bibliographic entries, specified as a multiple of standard line + height. +- `second-field-align' (`flush'or `margin'): The position of + second-field alignment. +- `hanging-indent' (boolean): Whether the bibliography items should + be rendered with hanging-indents." + (if (null (citeproc-style-bib-layout (citeproc-proc-style proc))) + "[NO BIBLIOGRAPHY LAYOUT IN CSL STYLE]" + (citeproc-proc-finalize proc) + (let* ((formatter (citeproc-formatter-for-format format)) + (rt-formatter (citeproc-formatter-rt formatter)) + (bib-formatter (or bib-formatter-fun + (citeproc-formatter-bib formatter))) + (bibitem-formatter (citeproc-formatter-bib-item formatter)) + (formatter-no-external-links (citeproc-formatter-no-external-links + formatter)) + (style (citeproc-proc-style proc)) + (bib-opts (citeproc-style-bib-opts style)) + (punct-in-quote (string= (alist-get 'punctuation-in-quote + (citeproc-style-locale-opts style)) + "true")) + (itemdata (citeproc-proc-itemdata proc)) + (filters (citeproc-proc-bib-filters proc))) + ;; Render raw bibitems for each itemdata struct and store them in the + ;; `rawbibitem' slot. + (maphash (lambda (_ itd) + (setf (citeproc-itemdata-rawbibitem itd) + (citeproc-rt-finalize + (citeproc-render-varlist-in-rt + (citeproc-itemdata-varvals itd) + style 'bib 'display internal-links + (or formatter-no-external-links no-external-links)) + punct-in-quote))) + itemdata) + (let* ((raw-bib + (if (citeproc-proc-filtered-bib-p proc) + ;; There are filters, we need to select and sort the subbibs. + (let* ((nr-of-filters (length filters)) + (result (make-list nr-of-filters nil)) + ;; We store boolean to-be-sorted flags for each sub-bib + (to-be-sorted (make-bool-vector nr-of-filters nil)) + (bib-sort (citeproc-style-bib-sort (citeproc-proc-style proc)))) + ;; Put the itds into subbib lists. + (maphash + (lambda (_ itd) + (let ((subbib-nos (citeproc-itemdata-subbib-nos itd))) + ;; Set to-be-sorted for later subbibs if itemdata + ;; occcurs in more than one. + (when-let ((later-subbib-nos (cdr subbib-nos))) + (dolist (subbib-no later-subbib-nos) + (setf (elt to-be-sorted subbib-no) t))) + ;; Push the item in all corresponding subbibs. + (dolist (subbib-no subbib-nos) + (push itd (elt result subbib-no))))) + itemdata) + ;; Sort the itds in each individual list + (setq result + (--map-indexed + (if (and bib-sort (elt to-be-sorted it-index)) + ;; Subbib contains earlier item, needs to sorted. + (citeproc-sort-itds it (citeproc-style-bib-sort-orders + (citeproc-proc-style proc))) + ;; No earlier item, sorting on citation-number. + (citeproc-sort-itds-on-citnum it)) + result)) + ;; Generate the raw bibs. + (--map (mapcar #'citeproc-itemdata-rawbibitem it) result)) + ;; No filters, so raw-bib is a list containing a single raw bibliograhy. + (list (mapcar #'citeproc-itemdata-rawbibitem + (citeproc-sort-itds-on-citnum (hash-table-values itemdata)))))) + ;; Perform author-substitution. + (substituted + (-if-let (subs-auth-subst + (alist-get 'subsequent-author-substitute bib-opts)) + (--map (citeproc-rt-subsequent-author-substitute it subs-auth-subst) + raw-bib) + raw-bib)) + ;; Calculate formatting params. + ;; NOTE: This is the only place where we check whether there are + ;; bibliography items in the processor, even though the empty case + ;; could be handled way more efficiently. + (max-offset (if (and (alist-get 'second-field-align bib-opts) + (not (hash-table-empty-p itemdata))) + (citeproc-proc-max-offset itemdata) + 0)) + (format-params (cons (cons 'max-offset max-offset) + (citeproc-style-bib-opts-to-formatting-params bib-opts))) + (formatted-bib + (--map (funcall bib-formatter + (mapcar + (lambda (x) + (funcall + bibitem-formatter + (funcall + rt-formatter (citeproc-rt-cull-spaces-puncts x)) + format-params)) + it) + format-params) + substituted))) + ;; Generate final return value. + (cons (if filters formatted-bib (car formatted-bib)) + format-params))))) + +(defun citeproc-clear (proc) + "Remove all bibliographic and citation data from PROC." + (clrhash (citeproc-proc-itemdata proc)) + (clrhash (citeproc-proc-names proc)) + (queue-clear (citeproc-proc-citations proc)) + (setf (citeproc-proc-finalized proc) t)) + +;; For one-off renderings + +(defun citeproc-create-style (style locale-getter &optional locale force-locale) + "Compile style in STYLE into a citeproc-style struct. +STYLE is either a path to a CSL style file, or a style as a +string. LOCALE-GETTER is a getter function for locales, the +optional LOCALE is a locale to prefer. If FORCE-LOCALE is non-nil +then use LOCALE even if the style's default locale is different." + (-let* (((year-suffix . parsed-style) (citeproc-style-parse style)) + (default-locale (alist-get 'default-locale (cadr parsed-style))) + (preferred-locale (if force-locale locale (or default-locale + locale + "en-US"))) + (act-parsed-locale (funcall locale-getter preferred-locale)) + (act-locale (alist-get 'lang (cadr act-parsed-locale))) + (style (citeproc-create-style-from-locale + parsed-style + (not (not year-suffix)) act-locale))) + (citeproc-style--update-locale style act-parsed-locale) + (citeproc-style--set-opt-defaults style) + (setf (citeproc-style-locale style) (or locale act-locale)) + style)) + +;; REVIEW: this should be rethought -- should we apply the specific wrappers as +;; well? +(defun citeproc-render-item (item-data style mode format + &optional no-external-links) + "Render a bibliography item described by ITEM-DATA with STYLE. +ITEM-DATA is the parsed form of a bibliography item description + in CSL-JSON format, +STYLE is a `citeproc-style' structure, +MODE is one of the symbols `bib' or `cite', +FORMAT is a symbol representing a supported output format. +If the optional NO-EXTERNAL-LINKS is non-nil then don't generate +external links in the item." + (let ((internal-varlist (--map-when (memq (car it) citeproc--date-vars) + (cons (car it) + (citeproc-date-parse (cdr it))) + item-data))) + (funcall (citeproc-formatter-rt (citeproc-formatter-for-format format)) + (citeproc-rt-cull-spaces-puncts + (citeproc-rt-finalize + (citeproc-render-varlist-in-rt + internal-varlist style mode 'display 'no-links no-external-links)))))) + +(provide 'citeproc) + +;;; citeproc.el ends here