update packages
This commit is contained in:
467
lisp/org-ref/org-ref-refproc.el
Normal file
467
lisp/org-ref/org-ref-refproc.el
Normal file
@@ -0,0 +1,467 @@
|
||||
;;; org-ref-refproc.el --- refproc - for exporting ref links in non-LaTeX backends -*- lexical-binding: t; -*-
|
||||
|
||||
;; For autoref and cref* links, a clever prefix is added at export.
|
||||
;; Prefixes are found in `org-ref-refproc-clever-prefixes'
|
||||
;; Use a keyword like this to set the style of clever prefixes. You can use a full or abbreviated prefix
|
||||
;;
|
||||
;; #+refproc: :abbreviate t :capitalize t
|
||||
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
(require 'org-ref-ref-links)
|
||||
|
||||
|
||||
(defcustom org-ref-refproc-clever-prefixes
|
||||
'((section :full "section" :abbrv "sec." :org-element headline)
|
||||
(figure :full "figure" :abbrv "fig." :org-element link)
|
||||
(table :full "table" :abbrv "tab." :org-element table)
|
||||
(equation :full "equation" :abbrv "eq." :org-element latex-environment)
|
||||
(proof :full "proof" :abbrv "pf." :org-element latex-environment)
|
||||
(listing :full "listing" :abbrv "lst." :org-element src-block)
|
||||
(lemma :full "lemma" :abbrv "lem." :org-element special-block)
|
||||
(theorem :full "theorem" :abbrv "thm." :org-element special-block)
|
||||
(corollary :full "corollary" :abbrv "cor." :org-element special-block))
|
||||
"Prefixes for cleveref links.
|
||||
plist with :full and :abbrv forms for each type.
|
||||
:org-element is the element these are defined in."
|
||||
:type 'sexp
|
||||
:group 'org-ref)
|
||||
|
||||
|
||||
|
||||
;; * refproc
|
||||
;;
|
||||
|
||||
(defun org-ref-refproc-get-options ()
|
||||
"Return a plist of options from a #+refproc keyword.
|
||||
Supported options are:
|
||||
:abbreviate (nil or non-nil)
|
||||
:capitalize (nil or non-nil)
|
||||
|
||||
These options only affect the cref* links."
|
||||
(read (format "(%s)" (cadr (assoc "REFPROC"
|
||||
(org-collect-keywords
|
||||
'("REFPROC")))))))
|
||||
|
||||
|
||||
(defun org-ref-get-ref-links ()
|
||||
"Return a list of ref links in the buffer."
|
||||
(org-element-map (org-element-parse-buffer) 'link
|
||||
(lambda (lnk)
|
||||
(when (assoc (org-element-property :type lnk) org-ref-ref-types)
|
||||
lnk))))
|
||||
|
||||
|
||||
(defun org-ref-refproc-referenceables ()
|
||||
"Return a list of referenceable items, grouped by type.
|
||||
This will be a list of (type label1 label2 ...).
|
||||
|
||||
Not all styles of target are currently supported. This supports
|
||||
named tables, figures and src-blocks, headlines with a custom_id,
|
||||
and latex_environments with a latex label or name (these are all
|
||||
considered equations, which might be wrong for other
|
||||
environments)."
|
||||
(let* ((parse-data (org-element-parse-buffer))
|
||||
type el
|
||||
;; for each type, we specify what org-element to get the labels from.
|
||||
(referencables (cl-loop for entry in org-ref-refproc-clever-prefixes
|
||||
do
|
||||
(setq type (car entry)
|
||||
el (plist-get (cdr entry) :org-element))
|
||||
collect
|
||||
(cons type
|
||||
(org-element-map parse-data el
|
||||
(lambda (e)
|
||||
(pcase el
|
||||
;; Headlines
|
||||
('headline
|
||||
(cond
|
||||
;; There is a custom_id, we use it.
|
||||
((org-element-property :CUSTOM_ID e)
|
||||
(org-element-property :CUSTOM_ID e))
|
||||
;; See if there is a target in the heading
|
||||
((string-match org-target-regexp
|
||||
(org-element-property :raw-value e))
|
||||
(match-string 1 (org-element-property :raw-value e)))
|
||||
;; Check for a label link
|
||||
((string-match (concat "label:" org-ref-label-re)
|
||||
(org-element-property :raw-value e))
|
||||
(match-string 1 (org-element-property :raw-value e)))))
|
||||
|
||||
;; Figures
|
||||
('link
|
||||
(cond
|
||||
;; file link with a name property
|
||||
((and (org-file-image-p (org-element-property :path e))
|
||||
(org-element-property
|
||||
:name (org-element-property :parent e)))
|
||||
(org-element-property
|
||||
:name (org-element-property :parent e)))
|
||||
;; a label link in the caption
|
||||
((and (org-file-image-p (org-element-property :path e))
|
||||
(org-element-property
|
||||
:caption (org-element-property :parent e))
|
||||
|
||||
(string-match (concat "label:" org-ref-label-re)
|
||||
(org-element-interpret-data
|
||||
(org-element-property
|
||||
:caption
|
||||
(org-element-property :parent e)))))
|
||||
(match-string 1 (org-element-interpret-data
|
||||
(org-element-property
|
||||
:caption
|
||||
(org-element-property :parent e)))))))
|
||||
|
||||
;; Tables
|
||||
('table
|
||||
(cond
|
||||
;; A name keyword is preferred
|
||||
((org-element-property :name e)
|
||||
(org-element-property :name e))
|
||||
;; a label link in a caption also works
|
||||
((string-match (concat "label:" org-ref-label-re)
|
||||
(or (org-element-interpret-data
|
||||
(org-element-property :caption e))
|
||||
""))
|
||||
(match-string 1 (org-element-interpret-data
|
||||
(org-element-property :caption e))))))
|
||||
|
||||
;; equations, proofs, and other latex environments
|
||||
('latex-environment
|
||||
(when (or (and (eq type 'equation)
|
||||
(string-match "\\\\begin{equation}"
|
||||
(org-element-property :value e)))
|
||||
(and (eq type 'proof) (string-match "\\\\begin{proof}"
|
||||
(org-element-property :value e))))
|
||||
|
||||
(cond
|
||||
;; Name keyword
|
||||
((org-element-property :name e)
|
||||
(org-element-property :name e))
|
||||
|
||||
;; latex label in the value
|
||||
((string-match "\\\\label{\\(.*\\)}" (org-element-property :value e))
|
||||
(match-string 1 (org-element-property :value e))))))
|
||||
|
||||
;; special blocks
|
||||
('special-block
|
||||
(cond
|
||||
((and (eq type 'lemma)
|
||||
(org-element-property :name e)
|
||||
(string= "lemma" (org-element-property :type e)))
|
||||
(org-element-property :name e))
|
||||
|
||||
((and (eq type 'corollary)
|
||||
(org-element-property :name e)
|
||||
(string= "corollary" (org-element-property :type e)))
|
||||
(org-element-property :name e))
|
||||
|
||||
((and (eq type 'theorem)
|
||||
(org-element-property :name e)
|
||||
(string= "theorem" (org-element-property :type e)))
|
||||
(org-element-property :name e))))
|
||||
|
||||
|
||||
;; Listings of code blocks
|
||||
('src-block
|
||||
(when-let (name (org-element-property :name e))
|
||||
name)))))))))
|
||||
referencables))
|
||||
|
||||
|
||||
(defun org-ref-refproc-get-type (label referenceables)
|
||||
"Get the type of reference LABEL refers to.
|
||||
REFERENCEABLES comes from `org-ref-refproc-referenceables'.
|
||||
Returns a plist (:type type :label label :index index)"
|
||||
(cl-loop for type in referenceables
|
||||
if (member label type)
|
||||
return (list :type (car type) :label label :index (seq-position (cdr type) label 'equal))))
|
||||
|
||||
|
||||
(defun org-ref-refproc-group-sort-labels (lbls referenceables)
|
||||
"Group and sort the labels in LBLS.
|
||||
REFERENCEABLES comes from `org-ref-refproc-referenceables'.
|
||||
Returns a list of (list (type l1 i1) (type l2, i2)...) where l1
|
||||
is label1, i1 is index1, etc.
|
||||
|
||||
This data structure has all the references from a single link
|
||||
grouped by type. For some links there will only be one type, and
|
||||
one label, because that is all that is allowed, e.g. for ref,
|
||||
eqref, pageref, nameref and autoref.
|
||||
|
||||
For the cref* links though you can have many labels, even to
|
||||
different kinds of things, and these are why we do the fancy
|
||||
grouping and sorting here."
|
||||
|
||||
(cl-loop for entry in
|
||||
(seq-group-by (lambda (el)
|
||||
(plist-get el :type))
|
||||
(cl-loop for label in lbls collect
|
||||
(org-ref-refproc-get-type label referenceables)))
|
||||
collect
|
||||
(sort (cdr entry) (lambda (a b)
|
||||
(< (plist-get a :index) (plist-get b :index))))))
|
||||
|
||||
|
||||
;; * Refproc - a reference processor for org-mode
|
||||
;;
|
||||
;; The strategy is to compute string replacements that are just org-syntax, then
|
||||
;; replace each link with the replacement.
|
||||
(defun org-ref-refproc-replacement (ref-link referenceables backend)
|
||||
"Compute a replacement for REF-LINK (an org-element).
|
||||
REFERENCEABLES comes from `org-ref-refproc-referenceables'.
|
||||
BACKEND is the export backend."
|
||||
(let* ((ref-type (org-element-property :type ref-link))
|
||||
(labels (split-string (org-element-property :path ref-link) ","))
|
||||
(post-blanks (org-element-property :post-blank ref-link))
|
||||
(data (cl-loop for label in labels collect (org-ref-refproc-get-type label referenceables))))
|
||||
|
||||
(pcase ref-type
|
||||
;; These types only allow one label in the reference
|
||||
("ref"
|
||||
(when (> (length data) 1)
|
||||
(error "A ref link can only have one label in it"))
|
||||
(setq data (cl-first data))
|
||||
(format "[[%s%s]]%s"
|
||||
(if (eq 'section (plist-get data :type))
|
||||
"#"
|
||||
"")
|
||||
(plist-get data :label)
|
||||
;; add back post blank spaces.
|
||||
(make-string post-blanks ? )))
|
||||
|
||||
("eqref"
|
||||
(when (> (length data) 1)
|
||||
(error "An eqref link can only have one label in it"))
|
||||
(setq data (cl-first data))
|
||||
(format (if (eq backend 'html)
|
||||
"[[%s]]%s"
|
||||
"([[%s]])%s")
|
||||
(plist-get data :label)
|
||||
;; add back post blank spaces.
|
||||
(make-string post-blanks ? )))
|
||||
|
||||
;; This one doesn't make much sense in unpaginated exports, and I don't
|
||||
;; have a way to get a page number anyway, so we make this a regular ref.
|
||||
("pageref"
|
||||
(when (> (length data) 1)
|
||||
(error "A pageref link can only have one label in it"))
|
||||
(setq data (cl-first data))
|
||||
(format "[[%s%s]]%s"
|
||||
(if (eq 'section (plist-get data :type))
|
||||
"#"
|
||||
"")
|
||||
(plist-get data :label)
|
||||
;; add back post blank spaces.
|
||||
(make-string post-blanks ? )))
|
||||
|
||||
;; this will use the heading name, or caption of the ref
|
||||
("nameref"
|
||||
(when (> (length data) 1)
|
||||
(error "A nameref link can only have one label in it"))
|
||||
(setq data (cl-first data))
|
||||
|
||||
;; Basically I follow the link, and depending on the ref type get a
|
||||
;; "name" for it. Right now there is no error if there is not a heading
|
||||
;; or caption, you would just get an empty string.
|
||||
(save-excursion
|
||||
(goto-char (org-element-property :begin ref-link))
|
||||
(search-forward ":")
|
||||
(org-ref-ref-jump-to (org-element-property :path ref-link))
|
||||
(pcase (plist-get data :type)
|
||||
('section
|
||||
(org-previous-visible-heading 1)
|
||||
(format "[[#%s][%s]]%s"
|
||||
(plist-get data :label)
|
||||
(cl-fifth (org-heading-components))
|
||||
(make-string post-blanks ? )))
|
||||
|
||||
('table
|
||||
(format "[[%s][%s]]%s"
|
||||
(plist-get data :label)
|
||||
(org-element-interpret-data (org-element-property :caption (org-element-context)))
|
||||
(make-string post-blanks ? )))
|
||||
|
||||
('figure
|
||||
(format "[[%s][%s]]%s"
|
||||
(plist-get data :label)
|
||||
(org-element-interpret-data (org-element-property :caption (org-element-context)))
|
||||
(make-string post-blanks ? )))
|
||||
|
||||
('listing
|
||||
(format "[[%s][%s]]%s"
|
||||
(plist-get data :label)
|
||||
(org-element-interpret-data (org-element-property :caption (org-element-context)))
|
||||
(make-string post-blanks ? )))
|
||||
;; does equation even make sense? is there ever a caption?
|
||||
(_
|
||||
(error "The nameref link is not implemented for %S" data)))))
|
||||
|
||||
;; autoref is the first place we have to be clever.
|
||||
("autoref"
|
||||
(when (> (length data) 1)
|
||||
(error "A pageref link can only have one label in it"))
|
||||
(setq data (cl-first data))
|
||||
|
||||
(let* ((prefix-data (cdr (assoc (plist-get data :type) org-ref-refproc-clever-prefixes)))
|
||||
(options (org-ref-refproc-get-options))
|
||||
(prefix (plist-get prefix-data (if (plist-get options :abbreviate)
|
||||
:abbrv
|
||||
:full))))
|
||||
(when (plist-get options :capitalize) (setq prefix (capitalize prefix)))
|
||||
(format "%s [[%s%s]]%s"
|
||||
prefix
|
||||
(if (eq 'section (plist-get data :type))
|
||||
"#"
|
||||
"")
|
||||
(plist-get data :label)
|
||||
(make-string post-blanks ? ))))
|
||||
|
||||
;; Now we get to the cref* links. These are complicated, so I will pass
|
||||
;; this out to dedicated functions. At this point, I have the ref-link,
|
||||
("cref"
|
||||
(org-ref-refproc-cref-replacement ref-link referenceables nil))
|
||||
|
||||
("Cref"
|
||||
(org-ref-refproc-cref-replacement ref-link referenceables t))
|
||||
|
||||
(_
|
||||
(error "%s links are not supported yet" ref-type)))))
|
||||
|
||||
|
||||
(defun org-ref-refproc-cref-replacement (ref-link referenceables capitalize)
|
||||
"Calculate a replacement for a REF-LINK.
|
||||
|
||||
REFERENCEABLES comes from `org-ref-refproc-referenceables'.
|
||||
|
||||
If CAPITALIZE is non-nil, capitalize the first entry (this is for
|
||||
Cref) and is different than the capitalize option in #+refproc:
|
||||
which capitalizes each prefix."
|
||||
(let* ((options (org-ref-refproc-get-options))
|
||||
;; I guess I know this will be cref or Cref here.
|
||||
;; (ref-type (org-element-property :type ref-link))
|
||||
(labels (split-string (org-element-property :path ref-link) ","))
|
||||
(post-blanks (org-element-property :post-blank ref-link))
|
||||
(data (cl-loop for label in labels collect (org-ref-refproc-get-type label referenceables)))
|
||||
(groups (seq-group-by (lambda (entry)
|
||||
(plist-get entry :type))
|
||||
data))
|
||||
;; this will be a list of sorted entries.
|
||||
(sorted-groups (cl-loop for group in groups collect
|
||||
(sort (cdr group) (lambda (a b)
|
||||
(< (plist-get a :index) (plist-get b :index))))))
|
||||
;; temp vars
|
||||
prefix
|
||||
prefix-data
|
||||
;; Now we have to be clever on each sorted group. One day I should add compression to the groups, e.g. 1,2,3 - > 1 to 3
|
||||
;; For each group we need a prefix, and it may have to be a plural prefix.
|
||||
;; If there are two members of a group, they are joined by and
|
||||
;; if there are more than two members of a group, they are separated by commas with and at the end.
|
||||
(replacements (cl-loop for collection in sorted-groups collect
|
||||
(pcase (length collection)
|
||||
;; One thing in the list
|
||||
(1
|
||||
(setq collection (cl-first collection)
|
||||
prefix-data (cdr (assoc (plist-get collection :type) org-ref-refproc-clever-prefixes))
|
||||
prefix (plist-get prefix-data (if (plist-get options :abbreviate)
|
||||
:abbrv
|
||||
:full)))
|
||||
(when (plist-get options :capitalize)
|
||||
(setq prefix (capitalize prefix)))
|
||||
(format "%s [[%s]]"
|
||||
;; prefix
|
||||
prefix
|
||||
(concat
|
||||
(if (eq 'section (plist-get collection :type)) "#" "")
|
||||
(plist-get collection :label))))
|
||||
(2
|
||||
;; the prefix can be found from the first label, but we have to make it plural.
|
||||
(setq prefix-data (cdr (assoc (plist-get (cl-first collection) :type)
|
||||
org-ref-refproc-clever-prefixes))
|
||||
prefix (plist-get prefix-data (if (plist-get options :abbreviate)
|
||||
:abbrv
|
||||
:full)))
|
||||
(when (plist-get options :capitalize)
|
||||
(setq prefix (capitalize prefix)))
|
||||
|
||||
;; Make it plural (substring "fig." -1)
|
||||
(setq prefix (if (string= "." (substring prefix -1))
|
||||
(concat (substring prefix 0 -1) "s.")
|
||||
(concat prefix "s")))
|
||||
|
||||
(format "%s [[%s]] and [[%s]]"
|
||||
prefix
|
||||
(concat
|
||||
(if (eq 'section (plist-get (cl-first collection) :type)) "#" "")
|
||||
(plist-get (cl-first collection) :label))
|
||||
(concat
|
||||
(if (eq 'section (plist-get (cl-second collection) :type)) "#" "")
|
||||
(plist-get (cl-second collection) :label))))
|
||||
|
||||
(_
|
||||
;; the prefix can be found from the first label, but we have to make it plural.
|
||||
(setq prefix-data (cdr (assoc (plist-get (cl-first collection) :type)
|
||||
org-ref-refproc-clever-prefixes))
|
||||
prefix (plist-get prefix-data (if (plist-get options :abbreviate)
|
||||
:abbrv
|
||||
:full)))
|
||||
(when (plist-get options :capitalize)
|
||||
(setq prefix (capitalize prefix)))
|
||||
|
||||
;; Make it plural. If the prefix ends in .
|
||||
;; (i.e. it is abbreviated) we remove it and
|
||||
;; add s.
|
||||
(setq prefix (if (string= "." (substring prefix -1))
|
||||
(concat (substring prefix 0 -1) "s.")
|
||||
(concat prefix "s")))
|
||||
|
||||
;; now get
|
||||
(format "%s %s and [[%s]]"
|
||||
prefix
|
||||
(string-join
|
||||
(cl-loop for entry in (butlast collection) collect
|
||||
(format "[[%s]]"
|
||||
(concat
|
||||
(if (eq 'section (plist-get entry :type)) "#" "")
|
||||
(plist-get entry :label))))
|
||||
", ")
|
||||
;; the last one
|
||||
(concat
|
||||
(if (eq 'section (plist-get (car (last collection)) :type)) "#" "")
|
||||
(plist-get (car (last collection)) :label))))))))
|
||||
|
||||
|
||||
(when capitalize (setf (car replacements) (concat (capitalize (substring (car replacements) 0 1)) (substring (car replacements) 1))))
|
||||
|
||||
;; Finally, join them together with commas, and add post-blank spaces.
|
||||
(concat
|
||||
(pcase (length replacements)
|
||||
(1
|
||||
(cl-first replacements))
|
||||
(2
|
||||
(concat (cl-first replacements) " and " (cl-second replacements)))
|
||||
(_
|
||||
(concat (string-join (butlast replacements) ", ") " and " (car (last replacements)))))
|
||||
|
||||
(make-string post-blanks ? ))))
|
||||
|
||||
|
||||
(defun org-ref-refproc (&optional backend)
|
||||
"Process the buffer replacing all ref links with org syntax.
|
||||
BACKEND is the
|
||||
Meant to be used in an `org-export-before-parsing-hook' on a copy
|
||||
of the buffer."
|
||||
(let ((ref-links (org-ref-get-ref-links))
|
||||
(referenceables (org-ref-refproc-referenceables)))
|
||||
|
||||
(cl-loop for ref in (reverse ref-links) do
|
||||
(cl--set-buffer-substring (org-element-property :begin ref)
|
||||
(org-element-property :end ref)
|
||||
(org-ref-refproc-replacement ref referenceables backend)))))
|
||||
|
||||
(provide 'org-ref-refproc)
|
||||
|
||||
;;; org-ref-refproc.el ends here
|
||||
Reference in New Issue
Block a user