193 lines
7.1 KiB
EmacsLisp
193 lines
7.1 KiB
EmacsLisp
;;; 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
|