forked from andras-simonyi/citeproc-el
-
Notifications
You must be signed in to change notification settings - Fork 0
/
citeproc-generic-elements.el
151 lines (134 loc) · 6.02 KB
/
citeproc-generic-elements.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
;;; citeproc-generic-elements.el --- render generic CSL elements -*- lexical-binding: t; -*-
;; Copyright (C) 2017-2021 András Simonyi
;; Author: András Simonyi <[email protected]>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; 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