-
Notifications
You must be signed in to change notification settings - Fork 9
/
citeproc-sort.el
192 lines (165 loc) · 7.11 KB
/
citeproc-sort.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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
;;; citeproc-sort.el --- cite and bibliography sorting -*- lexical-binding: t; -*-
;; Copyright (C) 2017 András Simonyi
;; Author: András Simonyi <andras.simonyi@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; 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