daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

pkg update and first config fix

Browse Source 
org-brain not working, add org-roam
This commit is contained in:
Daniel Weschke
2022-12-19 23:02:34 +01:00
parent 02b3e07185
commit 82f05baffe
885 changed files with 356098 additions and 36993 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
lisp/citeproc/citeproc-biblatex.el
View File

@@ -84,7 +84,7 @@
"Alist mapping biblatex item types to CSL item types.")
(defun citeproc-blt--to-csl-type (type entrysubtype)
"Return the csltype corresponding to blt TYPE and ENTRYSUBTYPE."
"Return the CSL type corresponding to blt TYPE and ENTRYSUBTYPE."
(pcase type
((or 'article 'periodical 'supperiodical)
(pcase entrysubtype
@@ -159,7 +159,7 @@
(version . version)
(volumes . number-of-volumes)
(pagetotal . number-of-pages)
(chapter-number . chapter)
(chapter . chapter-number)
(pages . page)
;; publisher
(origpublisher . original-publisher)
@@ -195,24 +195,22 @@ Only those fields are mapped that do not require further processing.")
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 (lambda (x)
(let* ((parsed (parse-time-string x))
;; TODO: use more elegant accessors for the parsed
;; time while keeping Emacs 26 compatibility.
(year (elt parsed 5))
(month (elt parsed 4))
(day (elt parsed 3))
date)
(when year
(when day (push day date))
(when month (push month date))
(push year date)
date)))
interval-strings)))
(mapcar #'citeproc-blt--parse-date interval-strings)))
(list (cons 'date-parts interval-date-parts))))
(defun citeproc-blt--get-standard (v b &optional with-nocase)
@@ -237,8 +235,7 @@ V is undefined in B."
"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. Return nil if
V is undefined in B."
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)))
@@ -348,7 +345,10 @@ biblatex variables in 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
@@ -361,7 +361,7 @@ biblatex variables in B."
citeproc-blt-editortype-to-csl-name-alist)))
(push (cons csl-var (citeproc-bt--to-csl-names ~editora))
result))
;; TODO: do this for editorb and editorc as well... dates
;; dates
(-when-let (issued (-if-let (~issued (alist-get 'date b))
(citeproc-blt--to-csl-date ~issued)
(-when-let (~year (alist-get 'year b))

26
lisp/citeproc/citeproc-bibtex.el
View File

@@ -293,7 +293,7 @@ brackets to the corresponding CSL XML spans."
;; Brackets indicate corporate entities without name parts.
((and (string= "{" (substring trimmed 0 1))
(string= "}" (substring trimmed -1)))
`((family . ,(citeproc-bt--to-csl (substring trimmed 1 -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)))
@@ -386,15 +386,21 @@ is not on this list are classified as non-dropping.")
"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."
(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)))))
(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."

95
lisp/citeproc/citeproc-cite.el
View File

@@ -48,7 +48,7 @@ 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',
`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
@@ -61,13 +61,22 @@ GROUPED is used internally to indicate whether the cites were
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)))
'((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))
@@ -77,7 +86,8 @@ key-value pair representations.")
(--filter (memq (car it)
'(label locator suppress-author suppress-date
stop-rendering-at position near-note
first-reference-note-number ignore-et-al))
first-reference-note-number ignore-et-al
bib-entry locator-only use-short-title))
cite)))
(nconc cite-vv item-vv)))
@@ -93,25 +103,52 @@ links else). For legacy reasons, any other value is treated as
`no-links'."
(-let* ((result nil)
((&alist 'suffix suff
'prefix pref)
'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))
(rendered-varlist
(citeproc-render-varlist-in-rt (citeproc-cite--varlist cite)
style 'cite 'display internal-links)))
(when (s-present-p plain-suff)
(push (citeproc-rt-from-str suff) result)
(unless (= (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)))
(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 (= (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.
@@ -193,8 +230,9 @@ For the optional INTERNAL-LINKS argument see
;; 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.
;; 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))
@@ -206,9 +244,12 @@ For the optional INTERNAL-LINKS argument see
(alist-get 'stopped-rendering (car rendered-author)))
(setq result `(nil ,rendered-author " " ,result)))))
;; Capitalize first
(if (citeproc-citation-capitalize-first c)
(citeproc-rt-change-case result #'citeproc-s-capitalize-first)
result)))))
(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.
@@ -317,7 +358,7 @@ For the optional INTERNAL-LINKS argument see
(ignore-et-al (citeproc-citation-ignore-et-al citation)))
(-when-let (mode-rep
(alist-get mode citeproc-cite--from-mode-alist))
(push mode-rep (car cites)))
(setf (car cites) (nconc (car cites) mode-rep)))
(when ignore-et-al
(push '(ignore-et-al . t) (car cites))))))
@@ -441,7 +482,7 @@ INDEX is the actual note-index, NND is the near-note-distance."
(defvar citeproc-disambiguation-cite-pos 'last
"Which cite position should be the basis of cite disambiguation.
Possible values are 'last, 'first and 'subsequent.")
Possible values are `last', `first' and `subsequent'.")
(defun citeproc-proc-update-positions (proc)
"Update all position-related fields in PROC."

88
lisp/citeproc/citeproc-context.el
View File

@@ -67,23 +67,27 @@ MODE is either `bib' or `cite', RENDER-MODE is `display' or `sort'."
(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."
(if (eq form 'short)
(-if-let* ((short-var (alist-get var citeproc--short-long-var-alist))
(short-var-val (alist-get short-var (citeproc-context-vars context))))
short-var-val
(alist-get var (citeproc-context-vars context)))
(let ((var-val (alist-get var (citeproc-context-vars context))))
(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-prange-render var-val prange-format sep))
var-val))))
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."
@@ -103,8 +107,8 @@ optional FORM can be nil, 'short or 'long."
(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."
CASE is one of the following: `lowercase', `uppercase',
`capitalize-first', `capitalize-all', `sentence', `title'."
(pcase case
('uppercase
(citeproc-rt-map-strings #'upcase rts t))
@@ -203,6 +207,23 @@ TYPED RTS is a list of (RICH-TEXT . TYPE) pairs"
(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.
@@ -237,25 +258,16 @@ external links."
(concat (alist-get var citeproc--link-prefix-alist
"")
(alist-get var var-alist))))))
;; Add appropriate item-no information
(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))))
(let* ((itemid-attr
(if (and note-style (not (eq internal-links 'bib-links)))
;; For note styles link subsequent cites to the first ones
(if (eq (alist-get 'position var-alist) '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)))
(itemid-attr-val (cons itemid-attr
(alist-get 'citation-number var-alist))))
(cond ((consp rendered) (setf (car rendered)
(-snoc (car rendered) itemid-attr-val)))
((stringp rendered) (setq rendered
(list (list itemid-attr-val) rendered)))))))
;; 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

69
lisp/citeproc/citeproc-formatters.el
View File

@@ -28,6 +28,7 @@
;;; Code:
(require 'let-alist)
(require 'subr-x)
(require 's)
(require 'cl-lib)
@@ -137,15 +138,39 @@ If ANCHOR is string= to TARGET then return ANCHOR."
(href . ,#'citeproc-fmt--org-link)
(cited-item-no . ,(lambda (x y) (concat "[[citeproc_bib_item_" y "][" x "]]")))
(bib-item-no . ,(lambda (x y) (concat "<<citeproc_bib_item_" y ">>" x)))
(font-style-italic . ,(lambda (x) (concat "/" x "/")))
(font-style-oblique . ,(lambda (x) (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)))
(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 "}")))
(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.
(when (= (aref result 0) 8203)
(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)
@@ -251,6 +276,36 @@ CSL tests."
(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
@@ -311,8 +366,10 @@ CSL tests."
: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-formatter-fun-create citeproc-fmt--org-alist)))
(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)))
(plain . ,(citeproc-formatter-create :rt #'citeproc-rt-to-plain

41
lisp/citeproc/citeproc-generic-elements.el
View File

@@ -111,8 +111,8 @@
content)))
(-when-let (match-pos
(and .prefix (s-matched-positions-all
citeproc-generic-elements--url-prefix-re
.prefix)))
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.
@@ -124,24 +124,27 @@
;; 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))))
.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)))))
(cons (citeproc-rt-format-single attrs content context) type))))
(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)

20
lisp/citeproc/citeproc-itemgetters.el
View File

@@ -153,16 +153,26 @@ without a `langid' field are not converted to sentence-case."
(org-map-entries
(lambda ()
(-when-let (key-w-entry (citeproc-bt-from-org-headline))
(puthash (car key-w-entry) (citeproc-bt-entry-to-csl
(cdr key-w-entry))
cache)))
(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)
(puthash key (citeproc-blt-entry-to-csl entry nil no-sentcase-wo-langid)
cache))
(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

4
lisp/citeproc/citeproc-locale.el
View File

@@ -1,6 +1,6 @@
;; citeproc-locale.el --- CSL locale related functions -*- lexical-binding: t; -*-
;; Copyright (C) 2017 András Simonyi
;; Copyright (C) 2017-2022 András Simonyi
;; Author: András Simonyi <andras.simonyi@gmail.com>
@@ -41,7 +41,7 @@
("ko" . "KR") ("nb" . "NO") ("nn" . "NO") ("sl" . "SI")
("sr" . "RS") ("sv" . "SE") ("uk" . "UA") ("vi" . "VN")
("zh" . "CN"))
"Alist mapping those locales to their default variants.
"Alist mapping locales to their default variants.
Only those locales are given for which the default variant is not
simply the result of upcasing.")

72
lisp/citeproc/citeproc-name.el
View File

@@ -36,6 +36,17 @@
(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
@@ -103,12 +114,9 @@ Nature."
(push `(plural . ,(if (> (length var-value) 1) "always" "never"))
label-attrs)))
(if with-label
(let ((form (alist-get 'form label-attrs))
(rendered-label (car (citeproc--label label-attrs context))))
(let ((rendered-label (car (citeproc--label label-attrs context))))
(citeproc-rt-join-formatted `((rendered-var . ,var))
(if (or label-before-names
(string= form "verb")
(string= form "verb-short"))
(if label-before-names
(list rendered-label rendered-names)
(list rendered-names rendered-label))
context))
@@ -208,15 +216,18 @@ Nature."
(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)))
(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)))
(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."
@@ -232,7 +243,7 @@ Nature."
(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
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."
@@ -260,7 +271,9 @@ sort order."
(rmode (citeproc-context-render-mode context)))
(if (citeproc-name--lat-cyr-greek-p name-alist)
(let ((g
(cond ((and show-given (= show-given 2)) g-uninited)
(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
@@ -318,8 +331,6 @@ NAME-ALIST is like in `citeproc-name--render-formatted'"
(cdr x)))
name-alist)))
;;NOTE: missing given names are currently dealt here by handling the names =
;;nil case there should be a more appropriate place.
(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,
@@ -327,16 +338,15 @@ 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."
(if (not names) nil
(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))))
(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.
@@ -396,7 +406,7 @@ contents."
(defun citeproc--var-plural-p (var context)
"Return whether the content of variable VAR is plural.
VAR is a symbol."
(let ((content (citeproc-var-value var context)))
(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)
@@ -427,6 +437,10 @@ VAR is a symbol."
(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)

6
lisp/citeproc/citeproc-pkg.el
View File

@@ -1,5 +1,5 @@
(define-package "citeproc" "20220101.1527" "A CSL 1.0.2 Citation Processor"
'((emacs "25")
(define-package "citeproc" "20221216.1238" "A CSL 1.0.2 Citation Processor"
'((emacs "26")
(dash "2.13.0")
(s "1.12.0")
(f "0.18.0")
@@ -7,7 +7,7 @@
(string-inflection "1.0")
(org "9")
(parsebib "2.4"))
:commit "abf3e45946598dffebfba6d6bd9a8cda46815765" :authors
:commit "3cb83db147bdda208520246e82dbf9878fa3cbd0" :authors
'(("András Simonyi" . "andras.simonyi@gmail.com"))
:maintainer
'("András Simonyi" . "andras.simonyi@gmail.com")

26
lisp/citeproc/citeproc-proc.el
View File

@@ -158,6 +158,19 @@ Return the itemdata struct that was added."
(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;
@@ -166,16 +179,9 @@ REP is its value in standard csl json representation as parsed by
PROC is the target citeproc-processor of the internal representation.
Return the PROC-internal representation of REP."
(cond ((memq var citeproc--name-vars)
(--map
(let* ((filtered (-remove (lambda (x) (eq (car x) 'isInstitution)) it))
(w-smart-aposts (--map (cons
(car it)
(let ((text-field (cdr it)))
(if (stringp text-field)
(citeproc-s-smart-apostrophes text-field)
text-field)))
filtered)))
(citeproc-proc--internalize-name w-smart-aposts proc))
(--map (citeproc-proc--internalize-name
(citeproc-proc--parse-csl-json-name it)
proc)
rep))
((memq var citeproc--date-vars)
(citeproc-date-parse rep))

87
lisp/citeproc/citeproc-rt.el
View File

@@ -43,7 +43,7 @@
(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-names href stopped-rendering rendered-locator-label)
"The rich-text content format attributes (used in raw output).")
(defconst citeproc-rt-ext-format-attrs
@@ -142,7 +142,7 @@ If optional SKIP-NOCASE is non-nil then skip spans with the
(_ (funcall fun rt))))
(defun citeproc-rt-replace-all-sim (replacements regex rts)
"Make all REPLACEMENTS sequentially in the strings of rich-texts 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))
@@ -276,7 +276,8 @@ on any dominated branch for which PRED holds."
((sc . nil) . (font-variant . "small-caps"))
((sup . nil) . (vertical-align . "sup"))
((sub . nil) . (vertical-align . "sub"))
((span . ((class . "nocase"))) . (nocase . t)))
((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)
@@ -564,6 +565,86 @@ modified bibliography."
(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

4
lisp/citeproc/citeproc-s.el
View File

@@ -244,8 +244,8 @@ REPLACEMENTS is an alist with (FROM . TO) elements."
(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.'"
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

4
lisp/citeproc/citeproc-style.el
View File

@@ -120,8 +120,8 @@ in-style locale information will be loaded (if available)."
(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."
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

22
lisp/citeproc/citeproc-subbibs.el
View File

@@ -1,6 +1,6 @@
;;; citeproc-subbibs.el --- support for subbibliographies -*- lexical-binding: t; -*-
;; Copyright (C) 2021 András Simonyi
;; Copyright (C) 2021-2022 András Simonyi
;; Author: András Simonyi <andras.simonyi@gmail.com>
@@ -30,19 +30,25 @@
(require 'citeproc-proc)
(require 'citeproc-itemdata)
(defun citeproc-sb-match-p (vv filter &optional use-blt-type)
"Return whether var-vals alist VV matches FILTER.
If optional USE-BLT-TYPE is non-nil then use the value for key
`blt-type' to evaluate type-based filter parts."
(let* ((type (alist-get (if use-blt-type 'blt-type 'type) vv))
(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))
(`(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)))
@@ -55,7 +61,7 @@ If optional USE-BLT-TYPE is non-nil then use the value for key
(subbib-nos
(-non-nil
(--map-indexed
(when (citeproc-sb-match-p varvals it) it-index)
(when (citeproc-sb--match-p varvals it) it-index)
filters))))
(setf (citeproc-itemdata-subbib-nos itemdata) subbib-nos)))
(citeproc-proc-itemdata proc))))

63
lisp/citeproc/citeproc.el
View File

@@ -1,12 +1,12 @@
;;; citeproc.el --- A CSL 1.0.2 Citation Processor -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2021 András Simonyi
;; Copyright (C) 2017-2022 András Simonyi
;; Author: András Simonyi <andras.simonyi@gmail.com>
;; Maintainer: András Simonyi <andras.simonyi@gmail.com>
;; URL: https://github.com/andras-simonyi/citeproc-el
;; Keywords: bib
;; Package-Requires: ((emacs "25") (dash "2.13.0") (s "1.12.0") (f "0.18.0") (queue "0.2") (string-inflection "1.0") (org "9") (parsebib "2.4"))
;; 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
;; This program is free software; you can redistribute it and/or modify
@@ -105,10 +105,24 @@ effect of adding all items available in the itemgetter."
(setf (citeproc-proc-finalized proc) nil))
(defun citeproc-add-subbib-filters (filters proc)
"Add subbib FILTERS to PROC.
FILTERS should be a list of alists in which the keys are one of
the symbols `type', `nottype', `keyword', `notkeyword', and
values are strings."
"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))
@@ -182,23 +196,36 @@ formatting parameters keyed to the parameter names as symbols:
punct-in-quote)))
itemdata)
(let* ((raw-bib
(if filters
;; There are filters, we need to select and sort the subbibs.
(let ((result (make-list (length filters) nil))
(bib-sort (citeproc-style-bib-sort (citeproc-proc-style proc))))
(if (cdr filters)
;; There are several 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)
(dolist (subbib-no (citeproc-itemdata-subbib-nos itd))
(push itd (elt result subbib-no))))
(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 list according to the sort settings
;; Sort the itds in each individual list
(setq result
(--map (if bib-sort
(citeproc-sort-itds it (citeproc-style-bib-sort-orders
(citeproc-proc-style proc)))
(citeproc-sort-itds-on-citnum it))
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 containg a single raw bibliograhy.