Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

919 lines
28 KiB

;;; readme.org --- org-ref-citeproc - Citation processor for org-mode
;;; Commentary: This code is style agnostic. It will get information from the
;;; information in `citation-style' and `bibliography-style'. These are defined
;;; in a csl.el file.
;;
;; Conventions:
;; an "entry" is the result of `bibtex-parse-entry'.
;;
;;; Commentary:
;;
(declare-function org-ref-get-bibtex-key-and-file "org-ref-core")
(declare-function org-ref-get-bibtex-keys "org-ref-core")
(declare-function parsebib-find-bibtex-dialect "parsebib")
(defvar org-export-current-backend)
(defvar org-ref-cite-types)
(require 'org-element)
;;; Code:
(defvar *orcp-citation-links* '()
"List of citation links in the text.
A link may have more than one citation in it. These links get
replaced by the new citation text.")
(defvar *orcp-unique-entries* '()
"List of unique (key . entry) parsed bibtex entries in the document.
The list is sorted according to the style. This list eventually
makes up the bibliography.")
(defvar citation-style '()
"Style data for an in-text citation.
For unsrt, a regular cite is superscripted, sorted,
range-collapsed numbers.
LABEL is a function that is run to get the label.
PREFIX goes before a citation.
SUFFIX goes after a citation.
citations are separated by DELIMITER.
SORT specifies that 3, 1, 2 be converted to 1,2,3
COLLAPSE is a function to collapse multiple citations, e.g. 1,2,3 becomes 1-3.
VERTICAL-ALIGN is a function that places the citation, e.g.
superscript, nil for baseline, etc...
Additional entries provide overrides for special citation types.")
(defvar bibliography-style '()
"Bibliography style data.
SORT is a function that sorts the entries, e.g. by author, or
year, or nil. It should take one argument, the list of unique
entries (key . entry).
LABEL is a function that returns how the entry is numbered, or
referenced in the text.
HANGING-INDENT is for the indentation of the entry on the left.
JUSTIFICATION is the overall justification on the right.
SPACING is the number of lines between entries.
HEADER is a string that is inserted above the bibliography.
ENTRIES is a alist of entry type and fields to make the entry from.")
;;* Collect citations
(defun orcp-collect-citations ()
"Return a list of citation links in the document."
(setq *orcp-citation-links*
(cl-loop for link in (org-element-map
(org-element-parse-buffer) 'link 'identity)
if (-contains?
org-ref-cite-types
(org-element-property :type link))
collect link)))
(defun orcp-key-to-entry (key)
"Return a parsed bibtex entry for KEY.
The KEY is found for the bibliography in the file."
(let* ((results (org-ref-get-bibtex-key-and-file key))
(bibfile (cdr results)))
(save-excursion
(with-temp-buffer
(insert-file-contents bibfile)
(bibtex-set-dialect (parsebib-find-bibtex-dialect) t)
(bibtex-search-entry key)
(let ((entry (bibtex-parse-entry t)))
(dolist (cons-cell entry)
(setf (car cons-cell) (downcase (car cons-cell))))
(setf (cdr (assoc "=type=" entry))
(downcase (cdr (assoc "=type=" entry))))
entry)))))
(defun orcp-collect-unique-entries ()
"Return a list of unique entries, sorted as required by the style.
Each entry is (key . entry)."
(let ((keys (org-ref-get-bibtex-keys))
sort-func
entries)
(setq entries
(cl-loop for key in keys
collect (cons key (orcp-key-to-entry key))))
;; Now we should sort them if the style requires it
(setq sort-func (cdr (assoc 'sort bibliography-style)))
(when sort-func
(setq entries (funcall sort-func entries)))
(setq *orcp-unique-entries* entries)))
;;** Unique entry sorting functions
(defun orcp-sort-entries-increasing-year (unique-entries)
"Sort UNIQUE-ENTRIES in increasing year of publication.
i.e. oldest stuff first."
(sort unique-entries
(lambda (a b)
(let* ((e1 (cdr a))
(e2 (cdr b))
(year1 (string-to-number (cdr (assoc "year" e1))))
(year2 (string-to-number (cdr (assoc "year" e2)))))
(> year2 year1)))))
(defun orcp-sort-entries-decreasing-year (unique-entries)
"Sort UNIQUE-ENTRIES in decreasing year.
i.e. most current first."
(reverse (orcp-sort-entries-increasing-year unique-entries)))
(defun orcp-get-entry-field (field entry)
"RETURN FIELD from ENTRY.
Strip extra spaces and carriage returns."
(let ((result (cdr (assoc field entry))))
(when result
(while (string-match "[\n\t\r]\\|[ \t][ \t]+" result)
(setq result (replace-match " " nil t result))))
result))
(defun orcp-sort-entries-alphabetical (unique-entries)
"Sort UNIQUE-ENTRIES alphabetically by first author last name."
(sort unique-entries
(lambda (a b)
(let* ((e1 (cdr a))
(e2 (cdr b))
(authors1 (s-split
" and "
(orcp-get-entry-field "author" e1)))
(author1 (orcp-parse-authorname (car authors1)))
;; lastname is "von last"
(last1 (concat (nth 1 author1) " " (nth 2 author1)))
(authors2 (s-split
" and "
(orcp-get-entry-field "author" e2)))
(author2 (orcp-parse-authorname (car authors2)))
(last2 (concat (nth 1 author2) " " (nth 2 author2))))
(string-lessp last1 last2)))))
;;* Citation labels for one citation key
;; No styling is done here.
(defun orcp-citation-number-label (key unique-entries)
"Find the numeric index of KEY in UNIQUE-ENTRIES and return as a string.
Indexing starts at 0 so we add one."
(number-to-string
(+ 1
(-find-index
(lambda (entry)
(string= key (car entry)))
unique-entries))))
(defun orcp-footnote-label (key unique-entries)
"Return an org footnote label for KEY in UNIQUE-ENTRIES."
(format "[fn:%s]" (orcp-citation-number-label key unique-entries)))
(defun orcp-citation-author-label (key unique-entries)
"Return an author last name label for KEY.
KEY is found in UNIQUE-ENTRIES."
(let* ((i (-find-index
(lambda (entry)
(string= key (car entry)))
unique-entries))
(entry (cdr (nth i unique-entries)))
(authors (s-split
" and "
(orcp-get-entry-field "author" entry)))
(first-author (orcp-parse-authorname (car authors))))
(format "%s" (concat (nth 1 first-author)
(nth 2 first-author)))))
(defun orcp-citation-year-label (key unique-entries)
"Return a year label for KEY.
KEY is found in UNIQUE-ENTRIES."
(let* ((i (-find-index
(lambda (entry)
(string= key (car entry)))
unique-entries))
(entry (cdr (nth i unique-entries)))
(year (orcp-get-entry-field "year" entry)))
(format "%s" year)))
(defun orcp-citation-author-year-label (key unique-entries)
"Return an author last name year label for KEY.
KEY is found in UNIQUE-ENTRIES.
We do not have a disambiguation strategy yet."
(let* ((i (-find-index
(lambda (entry)
(string= key (car entry)))
unique-entries))
(entry (cdr (nth i unique-entries)))
(authors (s-split
" and "
(orcp-get-entry-field "author" entry)))
(first-author (orcp-parse-authorname (car authors)))
(year (orcp-get-entry-field "year" entry)))
(format "%s %s" (concat (nth 1 first-author)
(nth 2 first-author))
year)))
;;* Replacements for citation links
;; Here we have to map over the keys in a citation, sort them according to the
;; style, get replacement labels, concat them together with the style delimiter,
;; add the prefix and suffix, and finally format for the type and output
;; backend.
(defun orcp-get-citation-style (symbol type)
"Get the style info for SYMBOL for a citation TYPE from `citation-style'.
Styles have a default, but allow TYPE overrides. This function
returns the style with the override."
(let (style)
;; first get default style
(setq style (cdr (assoc symbol citation-style)))
;; now check for an override
;; we need to find the type, and the symbol in the type
(when (and (assoc type citation-style)
(assoc symbol (assoc type citation-style)))
(setq style (cdr (assoc symbol (assoc type citation-style)))))
style))
(defun orcp-get-text-replacement (citation-link)
"Return replacement string for CITATION-LINK."
(let* ((type (intern (org-element-property :type citation-link)))
(path (org-element-property :path citation-link))
(keys (s-split "," path))
(entries (mapcar 'orcp-key-to-entry keys))
(label-func (orcp-get-citation-style 'label type))
(delimiter (orcp-get-citation-style 'delimiter type))
(sort-func (orcp-get-citation-style 'sort type))
labels
replacement-text)
;; sort is not coded yet. I am not sure the best data to sort here. the keys?
(when sort-func
(setq keys (sort keys sort-func)))
;; get labels. This function is where you would, for example, create
;; hyperlinks to the bibliography. This function should return a list of
;; strings
(setq labels
(mapcar
(lambda (key)
(funcall label-func key *orcp-unique-entries*))
keys))
;; collapse range - not used yet.
;; now get a string collecting everything
(setq labels (mapconcat 'identity labels delimiter))
(setq replacement-text (concat
(orcp-get-citation-style 'prefix type)
labels
(orcp-get-citation-style 'suffix type)))
;; finally, call formatter
(funcall (or (orcp-get-citation-style 'vertical-align type)
'baseline)
replacement-text)))
(defun orcp-get-citation-replacements ()
"Get a list of replacements for all links in `*orcp-citation-links*'."
(mapcar 'orcp-get-text-replacement *orcp-citation-links*))
;;* Formatted bibliography
(defun orcp-formatted-bibliography ()
"Return the formatted bibliography."
(let* ((spacing (or (cdr (assoc 'spacing bibliography-style)) 1))
(label-func (cdr (assoc 'label bibliography-style)))
(label-prefix (cdr (assoc 'label-prefix bibliography-style)))
(label-suffix (cdr (assoc 'label-suffix bibliography-style)))
(justification (cdr (assoc 'justification bibliography-style)))
(hanging-indent (cdr (assoc 'hanging-indent bibliography-style)))
(header (cdr (assoc 'header bibliography-style)))
(unique-entries (orcp-collect-unique-entries))
(adaptive-fill-function '(lambda () " "))
(indent-tabs-mode nil)
bibliography-string)
(setq bibliography-string
(mapconcat
'identity
;; loop over the entries in the bibliography
(cl-loop for entry in unique-entries
collect
(progn
(let* ((entry-type (downcase
(cdr (assoc "=type=" (cdr entry)))))
(key (cdr (assoc "=key=" (cdr entry))))
(entry-styles (cdr (assoc 'entries bibliography-style)))
(entry-fields
(progn
(if (cdr (assoc (intern entry-type) entry-styles))
(cdr (assoc (intern entry-type) entry-styles))
(warn "%s not found. Using default." entry-type)
(cdr (assoc 't entry-styles))
)))
(funcs (mapcar
(lambda (field)
(if (fboundp (intern
(format "orcp-%s" field)))
(intern
(format "orcp-%s" field))
;; No formatter found. just get the data
`(lambda (entry)
(orcp-get-entry-field
,(symbol-name field) entry))))
entry-fields))
(label (concat label-prefix
(funcall label-func key unique-entries)
label-suffix)))
;; this is the entry. We do this in a buffer to make it
;; easy to indent, fill, etc...
(with-temp-buffer
(insert label)
(insert (mapconcat (lambda (field-func)
(funcall field-func entry))
funcs
""))
(goto-char (point-min))
(forward-word)
;; It doesn't make sense to do this for all formats, e.g.HTML.
;; commenting out for now.
;; (increase-left-margin
;; (point-min) (point-max) hanging-indent)
;; (fill-region (point-min) (point-max) justification)
(buffer-string)))))
;; Here we put in the separator between entries
(cond
;; placeholder for other formats
((eq org-export-current-backend 'html)
" @@html:<br>@@\n")
(t
;; put in a \n for each spacing
(mapconcat 'identity
(cl-loop for i to spacing
collect "\n")
"")))))
;; TODO: figure out header. how do we insert it properly formatted?
bibliography-string))
;;* Text formatting functions.
;; These take text, and format them according to a backend. We derive the
;; backend from `org-export-current-backend' because I anticipate using this
;; during export.
(defun baseline (text)
"Return TEXT."
text)
(defun superscript (text)
"Format TEXT as superscripted."
(cond
((eq org-export-current-backend 'html)
(format "@@html:<sup>%s</sup>@@" text))
;; the catch-all case is org-syntax
(t
(format "^{%s}" text))))
(defun italics (text)
"Format TEXT as italics."
(cond
((eq org-export-current-backend 'html)
(format "@@html:<i>%s</i>@@" text))
;; the catch-all case is org-syntax
(t
(format "/%s/" text))))
(defun bold (text)
"Format TEXT in bold."
(cond
((eq org-export-current-backend 'html)
(format "@@html:<b>%s</b>@@" text))
;; the catch-all case is org-syntax
(t
(format "*%s*" text))))
;;* Field formatting functions
;;These should be style agnostic functions. They take an entry and return a
;; formatted field for the entry, using information from the csl file.
(defun firstname (author-cell)
"Return firstname from AUTHOR-CELL."
(car author-cell))
(defun lastname (author-cell)
"Return lastname from AUTHOR-CELL."
(cdr author-cell))
(defun orcp-author (entry)
"Return formatted author string from the ENTRY.
ENTRY is from `bibtex-parse-entry'.
Style information comes from `bibliography'"
(let* ((style (cdr (assoc 'author bibliography-style)))
(delimiter (cdr (assoc 'delimiter style)))
(name1 (nth 0 (cdr (assoc 'name-order style))))
(name2 (nth 1 (cdr (assoc 'name-order style))))
(name-separator (cdr (assoc 'name-separator style)))
(suffix (cdr (assoc 'suffix style)))
(field-separator (cdr (assoc 'field-separator style)))
(et-al (cdr (assoc 'et-al style)))
(authors (s-split
" and "
(or
(orcp-get-entry-field "author" entry)
"")))
;; parse to list of (first von last jr)
(author-data (mapcar
(lambda (x)
(let ((aud (orcp-parse-authorname x)))
(cons (nth 0 aud)
(concat
(or (nth 1 aud) "")
(or (nth 2 aud) "")
(or (nth 3 aud) "")))))
authors))
;; map first and last names, in order specified in style with separator
(author-names
(mapcar
(lambda (x)
(concat
(funcall name1 x)
name-separator
(funcall name2 x)))
author-data)))
;; check on et-al - not implemented yet
;; work on initialize - not implemented yet
;; mapconcat on delimiter then last author.
(if (= 1 (length author-names))
(concat (car author-names) suffix field-separator)
(concat
(mapconcat
'identity
(butlast author-names)
delimiter)
(cdr (assoc 'last-author-delimiter style))
(car (last author-names))
suffix
field-separator))))
(defun orcp-title (entry)
"Return formatted title for the bibtex ENTRY."
(let* ((style (cdr (assoc 'title bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(suffix (cdr (assoc 'suffix style)))
(field-separator (cdr (assoc 'field-separator style)))
(title (orcp-get-entry-field "title" entry)))
(concat
(if font-style
(funcall font-style title)
title)
suffix
field-separator)))
(defun orcp-journal (entry)
"Return formatted journal for the bibtex ENTRY."
(let* ((style (cdr (assoc 'journal bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(suffix (cdr (assoc 'suffix style)))
(field-separator (cdr (assoc 'field-separator style)))
(journal (orcp-get-entry-field "journal" entry)))
(concat
(if font-style
(funcall font-style journal)
journal)
suffix
field-separator)))
(defun orcp-volume (entry)
"Return formatted volume for the bibtex ENTRY."
(let* ((style (cdr (assoc 'volume bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(prefix (cdr (assoc 'prefix style)))
(suffix (eval (cdr (assoc 'suffix style))))
(field-separator (cdr (assoc 'field-separator style)))
(volume (orcp-get-entry-field "volume" entry)))
(setq volume (concat prefix volume suffix))
(concat
(if font-style
(funcall font-style volume)
volume)
field-separator)))
(defun orcp-issue (entry)
"Return formatted issue for the bibtex ENTRY."
(let* ((style (cdr (assoc 'issue bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(prefix (cdr (assoc 'prefix style)))
(suffix (cdr (assoc 'suffix style)))
(field-separator (cdr (assoc 'field-separator style)))
(issue (orcp-get-entry-field "number" entry)))
;; issue is optional and isn't always present.
(if (not issue)
field-separator
(setq issue (concat prefix issue suffix))
(if font-style
(funcall font-style
issue)
issue))))
(defun orcp-pages (entry)
"Return formatted pages for the bibtex ENTRY."
(let* ((style (cdr (assoc 'pages bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(prefix (cdr (assoc 'prefix style)))
(suffix (cdr (assoc 'suffix style)))
(field-separator (cdr (assoc 'field-separator style)))
(pages (orcp-get-entry-field "pages" entry)))
(setq pages (concat prefix pages suffix))
;; collapse-range not supported yet
(concat (if font-style
(funcall font-style
pages)
pages)
field-separator)))
(defun orcp-year (entry)
"Return formatted year for the bibtex ENTRY."
(let* ((style (cdr (assoc 'year bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(prefix (cdr (assoc 'prefix style)))
(suffix (cdr (assoc 'suffix style)))
(field-separator (cdr (assoc 'field-separator style)))
(year (orcp-get-entry-field "year" entry)))
(setq year (concat prefix year suffix))
;; collapse-range not supported yet
(concat
(if font-style
(funcall font-style
year)
year)
field-separator)))
(defun orcp-doi-formatter (doi)
"Return formatted DOI for different backends."
(cond
((eq org-export-current-backend 'html)
(format "http://dx.doi.org/%s" doi))
(t
(format "doi:%s" doi))))
(defun orcp-doi (entry)
"Return formatted doi for the bibtex ENTRY."
(let* ((style (cdr (assoc 'doi bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(prefix (cdr (assoc 'prefix style)))
(suffix (cdr (assoc 'suffix style)))
(formatter (cdr (assoc 'formatter style)))
(doi (orcp-get-entry-field "doi" entry)))
(when formatter
(setq doi (funcall formatter doi)))
(setq doi (concat prefix doi suffix))
(if font-style
(funcall font-style
(concat prefix doi suffix))
doi)))
(defun orcp-url (entry)
"Return formatted url for the bibtex ENTRY."
(let* ((style (cdr (assoc 'doi bibliography-style)))
(font-style (cdr (assoc 'font-style style)))
(prefix (cdr (assoc 'prefix style)))
(suffix (cdr (assoc 'suffix style)))
(formatter (cdr (assoc 'formatter style)))
(url (orcp-get-entry-field "url" entry)))
(when formatter
(setq url (funcall formatter url)))
(setq url (concat prefix url suffix))
(if font-style
(funcall font-style
(concat prefix url suffix))
url)))
;;* Data structures for Author names
(defun orcp-unprotect-brackets (piece protected-strings)
"Unprotect PIECE with the information in PROTECTED-STRINGS.
PROTECTED-STRINGS is a list of cons-cells (\"protection\" .
original text)."
(when piece
(mapc
(lambda (cons-cell)
(when (string-match (car cons-cell) piece)
(setq piece (replace-match (cdr cons-cell) t t piece))))
protected-strings))
piece)
;; See http://maverick.inria.fr/~Xavier.Decoret/resources/xdkbibtex/bibtex_summary.html#names for the parsing rules.
(defun orcp-parse-authorname (name)
"Convert an author NAME to (first von last jr) data structure.
Valid name forms are:
First1 First2 Last
First1 First 2 {Last1 Last2}
First1 First2 von1 von2 Last1 Last2
von1 von2 Last1 Last2, Jr., First1 First2
Last1, First1 First2
{Von Last1}, First1 First2
We try to protect strings in curly brackets."
(let* (protected-strings
uuid
ncommas
fields
first von last jr)
;; protect bracketed strings
(while (string-match "{\\(.*\\)}" name)
;; We want our substitute to look like a name, not a von part so we add a
;; capital letter to the front.
(setq uuid (concat "A" (md5 (format "%s%s%s%s%s%s%s"
(random)
(current-time)
(user-uid)
(emacs-pid)
(user-full-name)
user-mail-address
(recent-keys)))))
(add-to-list 'protected-strings (cons uuid (match-string 0 name)))
(setq name (replace-match uuid nil nil name)))
(setq ncommas (s-count-matches "," name))
(cond
;; "First von Last"
((= 0 ncommas)
(setq fields (s-split " " name))
(while (and (s-capitalized? (car fields)) (> (length fields) 1))
(setq first (append first (list (pop fields)))))
(when first
(setq first (mapconcat 'identity first " ")))
;; Next, we get the von part. this is the longest white space delimited
;; string that ends with a lowercase word, and is not the rest of the
;; string.
(let ((last-lower-index nil))
(cl-loop for i to (length fields)
for word in (butlast fields)
if (s-lowercase? word)
do (setq last-lower-index i))
(when last-lower-index
(setq von (mapconcat
'identity
(-slice fields 0 (+ 1 last-lower-index)) " "))
(setq fields (-slice fields (+ 1 last-lower-index)))))
;; all that should be left is the last name but it might be more than one
;; word, e.g. with a Jr. or a two work last name.
(setq last (mapconcat 'identity fields " "))
(mapcar
(lambda (x)
(orcp-unprotect-brackets x protected-strings))
(list first von last jr)))
;; "von Last, First"
((= 1 ncommas)
(setq fields (s-split "," name))
(setq first (nth 1 fields))
;; split first field which could be von Lastname.
(setq fields (s-split " " (car fields)))
(let ((last-lower-index nil))
(cl-loop for i to (length fields)
for word in fields
if (s-lowercase? word)
do (setq last-lower-index i))
(when last-lower-index
(setq von (mapconcat
'identity
(-slice fields 0 (+ 1 last-lower-index)) " "))
(setq fields (-slice fields (+ 1 last-lower-index)))))
;; all that should be left is the last name
(setq last (mapconcat 'identity fields " "))
(mapcar
(lambda (x)
(orcp-unprotect-brackets x protected-strings))
(list first von last jr)))
;; "von Last, Jr, First"
((= 2 ncommas)
(setq fields (s-split "," name))
(setq first (nth 2 fields))
(setq jr (nth 1 fields))
;; split first field which could be von Lastname.
(setq fields (s-split " " (car fields)))
(let ((last-lower-index nil))
(cl-loop for i to (length fields)
for word in fields
if (s-lowercase? word)
do (setq last-lower-index i))
(when last-lower-index
(setq von (mapconcat 'identity (-slice fields 0 (+ 1 last-lower-index)) " "))
(setq fields (-slice fields (+ 1 last-lower-index)))))
;; all that should be left is the last name
(setq last (mapconcat 'identity fields " "))
(mapcar
(lambda (x)
(orcp-unprotect-brackets x protected-strings))
(list first von last jr))))))
;;* Collapse numeric range
(defun orcp-collapse-numeric-range (cites delimiter)
"TODO use style info.
Collapse a numeric list of CITES into a range.
Collapsed ranges are separated by DELIMITER."
(let (n
(groups '()))
(while cites
(setq n (pop cites))
(if (and (caar groups) (= (- n 1) (elt (car groups) 0)))
(setf (car groups) (append `(,n) (car groups)))
(setf groups (append `((,n)) groups))))
;; Now for each group
(mapconcat 'identity
(mapcar
(lambda (lst)
(cond
((>= (length lst) 3)
(format "%s-%s" (car lst) (car (last lst))))
((= (length lst) 2)
(format "%s,%s" (nth 0 lst) (nth 1 lst)))
(t
(number-to-string (car lst)))))
(mapcar 'reverse (reverse groups)))
delimiter)))
;;* Putting it all together
(defun sentence-beginning-p ()
"Determine if point is at the beginning of a sentence.
The idea is to move forward a sentence, then back. If the point
doesn't move, it means you were at the beginning of a sentence."
(let ((cp (point)))
(save-excursion
(forward-sentence)
(backward-sentence)
(= cp (point)))))
(defun orcp-citeproc (&optional backend)
"Format citations and bibliography for BACKEND.
Warning. Destructive to your document! Will replace links.
Meant to be used in export on a temporary version of the
documents."
;; Get the style from bibliographystyle link
;; and eliminate bibliography style links
;; This will load all style modules
(cl-loop for link in (org-element-map
(org-element-parse-buffer) 'link 'identity)
if (string= "bibliographystyle"
(org-element-property :type link))
do
;; get path for style and load it
(load-library (org-element-property :path link))
;; get rid of the link in the buffer
(setf (buffer-substring (org-element-property :begin link)
(org-element-property :end link))
""))
(orcp-collect-citations)
(orcp-collect-unique-entries)
(let ((link-replacements (cl-loop for link in *orcp-citation-links*
for repl in (orcp-get-citation-replacements)
collect
(list repl
(org-element-property :begin link)
(org-element-property :end link))))
(bibliography-string (orcp-formatted-bibliography))
punctuation
trailing-space
bibliography-link)
;; replace citation links
(cl-loop for (repl start end) in (reverse link-replacements)
for link in (reverse *orcp-citation-links*)
do
;; chomp leading spaces if needed
(when (orcp-get-citation-style
'chomp-leading-space
(intern (org-element-property :type link)))
(goto-char start)
(while (and (not (sentence-beginning-p))
(looking-back " " (- (point) 2)))
(delete-char -1)
(setq start (- start 1))
(setq end (- end 1))))
;; chomp trailing spaces if needed
(when (orcp-get-citation-style
'chomp-trailing-space
(intern (org-element-property :type link)))
(goto-char end)
(while (looking-back " " (- (point) 2))
(delete-char 1)))
;; Check for transposing punctuation
(setq punctuation nil)
(when (orcp-get-citation-style
'transpose-punctuation
(intern (org-element-property :type link)))
;; goto end of link
(goto-char end)
(when (looking-at "\\.\\|,\\|;")
(setq punctuation (buffer-substring end (+ 1 end)))
(delete-char 1)))
;; preserve trailing space
(goto-char end)
(setq trailing-space (if (looking-back " " (line-beginning-position)) " " ""))
(setf (buffer-substring start end) (concat repl trailing-space))
(when punctuation
(goto-char start)
;; I can't figure out why this is necessary. I would have thought
;; the chomp leading spaces would get it.
(when (thing-at-point 'whitespace)
(delete-char -1))
(insert punctuation)))
;; Insert bibliography section at the bibliography link
(setq bibliography-link (cl-loop for link
in (org-element-map
(org-element-parse-buffer)
'link 'identity)
if (string= "bibliography"
(org-element-property :type link))
collect link))
(pcase (length bibliography-link)
((pred (< 1)) (error "Only one bibliography link allowed"))
((pred (= 1))
;; replace bibliography link
(setq bibliography-link (car bibliography-link))
(setf (buffer-substring (org-element-property :begin bibliography-link)
(org-element-property :end bibliography-link))
bibliography-string))
((pred (= 0))
;; no bibliography link in document
(when link-replacements
(message "Warning: No bibliography link found although there are citations to process"))))))
;; * the end
(provide 'org-ref-citeproc)
;;; org-ref-citeproc.el ends here