962 lines
36 KiB
EmacsLisp
962 lines
36 KiB
EmacsLisp
;;; org-ref-ref-links.el --- cross-reference links for org-ref -*- lexical-binding: t; -*-
|
|
;;
|
|
;; Copyright (C) 2021-2024 John Kitchin
|
|
|
|
;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
|
|
;; Keywords: convenience
|
|
|
|
;; 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/>.
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
|
|
;;; Code:
|
|
(eval-and-compile (require 'org-macs))
|
|
(eval-and-compile (require 'ol))
|
|
|
|
;; Declare functions from org-element
|
|
(declare-function org-element-context "org-element" (&optional element))
|
|
(declare-function org-element-property "org-element" (property element))
|
|
(declare-function org-element-type "org-element" (element))
|
|
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
|
|
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
|
|
(declare-function org-element-interpret-data "org-element" (data))
|
|
|
|
;; Declare functions from org
|
|
(declare-function org-mark-ring-push "org" (&optional pos buffer))
|
|
(declare-function org-file-image-p "org" (file &optional extensions))
|
|
(declare-function org-at-table-p "org" (&optional table-type))
|
|
(declare-function org-table-begin "org" (&optional table-type))
|
|
|
|
;; Declare functions from ox (org-export)
|
|
(declare-function org-export-get-caption "ox" (element &optional short))
|
|
|
|
(defcustom org-ref-default-ref-type "ref"
|
|
"Default ref link type to use when inserting ref links."
|
|
:type 'string
|
|
:group 'org-ref)
|
|
|
|
|
|
(defcustom org-ref-activate-ref-links t
|
|
"If non-nil use font lock to activate ref links.
|
|
Activation can be slow in large documents with a lot of ref
|
|
links. Set this to nil to turn off activation."
|
|
:type 'boolean
|
|
:group 'org-ref)
|
|
|
|
|
|
(defcustom org-ref-show-equation-images-in-tooltips nil
|
|
"If non-nil, show rendered equation images in tooltips for equation references.
|
|
Requires that equations have been previewed with `org-latex-preview' or
|
|
a compatible preview package (like math-preview).
|
|
|
|
When enabled, hovering over an equation reference (eqref, ref, etc.) will
|
|
display the rendered equation image in a tooltip instead of raw LaTeX code.
|
|
|
|
This feature works best in GUI Emacs. In terminal Emacs, falls back to
|
|
text display."
|
|
:type 'boolean
|
|
:group 'org-ref)
|
|
|
|
|
|
(defcustom org-ref-enable-multi-file-references t
|
|
"If non-nil, collect labels from files included via #+INCLUDE directives.
|
|
|
|
When enabled, org-ref will search for labels not only in the current buffer,
|
|
but also in all files referenced via #+INCLUDE directives. This allows
|
|
cross-references to work across multiple files in a project.
|
|
|
|
Labels are cached per-file and only re-scanned when files change, using
|
|
timestamp-based change detection for performance.
|
|
|
|
For single-file documents, this feature has minimal overhead since no
|
|
#+INCLUDE directives are present. Set to nil to disable if needed."
|
|
:type 'boolean
|
|
:group 'org-ref)
|
|
|
|
|
|
(defface org-ref-ref-face
|
|
`((t (:inherit org-link :foreground "dark red")))
|
|
"Face for ref links in org-ref."
|
|
:group 'org-ref-faces)
|
|
|
|
|
|
(defvar org-ref-label-re
|
|
(rx-to-string
|
|
'(group-n 1 (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~"))))
|
|
"Regexp for labels.")
|
|
|
|
|
|
(defvar org-ref-label-link-re
|
|
(rx-to-string
|
|
`(seq "label:" (group-n 1 (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~")))))
|
|
"Regexp for label links.")
|
|
|
|
|
|
(defvar org-ref-ref-label-regexps
|
|
(list
|
|
(concat ":ID:\\s-+" org-ref-label-re "\\_>")
|
|
;; CUSTOM_ID in a heading
|
|
(concat ":CUSTOM_ID:\\s-+" org-ref-label-re "\\_>")
|
|
;; #+name
|
|
(concat "^\\s-*#\\+name:\\s-+" org-ref-label-re "\\_>")
|
|
;; labels in latex
|
|
(concat "\\\\label{" org-ref-label-re "}")
|
|
;; A target, code copied from org-target-regexp and group 1 numbered.
|
|
(let ((border "[^<>\n\r \t]"))
|
|
(format "<<\\(?1:%s\\|%s[^<>\n\r]*%s\\)>>"
|
|
border border border))
|
|
;; A label link
|
|
(concat "label:" org-ref-label-re "\\_>")
|
|
"\\\\lstset{.*label=\\(?1:.*?\\),.*}")
|
|
"List of regular expressions to labels.
|
|
The label should always be in group 1.")
|
|
|
|
|
|
(defvar org-ref-ref-types
|
|
'(("ref" "A regular cross-reference to a label")
|
|
("eqref" "A cross-reference to an equation")
|
|
("pageref" "to the page number a label is on")
|
|
("nameref" "to the name associated with a label (e.g. a caption)")
|
|
("autoref" "from hyperref, adds automatic prefixes")
|
|
("Autoref" "from hyperref, capitalized version of autoref")
|
|
("cref" "from cleveref, adds automatic prefixes, and condenses multiple refs")
|
|
("Cref" "from cleveref, capitalized version of cref")
|
|
("crefrange" "from cleveref, makes a range of refs from two refs with a prefix")
|
|
("Crefrange" "from cleveref, capitalized prefix version of crefrange"))
|
|
"List of ref link types (type description).")
|
|
|
|
|
|
(defun org-ref-select-ref-type ()
|
|
"Select a ref type with annotated completion."
|
|
(let* ((type-annotation (lambda (s)
|
|
(let ((item (assoc s minibuffer-completion-table)))
|
|
(when item (concat
|
|
(make-string (- 12 (length s)) ? )
|
|
"-- "
|
|
(cl-second item))))))
|
|
(completion-extra-properties `(:annotation-function ,type-annotation)))
|
|
(completing-read "Type: " org-ref-ref-types)))
|
|
|
|
|
|
(defun org-ref-change-ref-type (new-type)
|
|
"Change the ref type to NEW-TYPE."
|
|
(interactive (list (org-ref-select-ref-type)))
|
|
(let* ((cite-link (org-element-context))
|
|
(old-type (org-element-property :type cite-link))
|
|
(begin (org-element-property :begin cite-link))
|
|
(end (org-element-property :end cite-link))
|
|
(bracketp (eq 'bracket (org-element-property :format cite-link)))
|
|
(path (org-element-property :path cite-link))
|
|
(deltap (- (point) begin)))
|
|
;; note this does not respect brackets
|
|
(cl--set-buffer-substring begin end
|
|
(concat
|
|
(if bracketp "[[" "")
|
|
new-type ":" path
|
|
(if bracketp "]]" "")))
|
|
;; try to preserve the character the point is on.
|
|
(goto-char (+ begin deltap (- (length new-type) (length old-type))))))
|
|
|
|
|
|
(defvar-local org-ref-label-cache nil
|
|
"Buffer-local cache variable for labels.")
|
|
|
|
|
|
(defvar-local org-ref-buffer-chars-modified-tick nil
|
|
"Buffer-local variable to hold `buffer-chars-modified-tick'.")
|
|
|
|
|
|
(defvar-local org-ref-preview-image-cache nil
|
|
"Buffer-local cache of (label . image-spec) for preview images.")
|
|
|
|
|
|
(defvar-local org-ref-preview-cache-tick nil
|
|
"Buffer modification tick when preview image cache was last updated.")
|
|
|
|
|
|
;; Multi-file reference support - global caches
|
|
(defvar org-ref-project-label-cache (make-hash-table :test 'equal)
|
|
"Hash table mapping project-root -> ((file . labels-alist) ...).
|
|
Used when `org-ref-enable-multi-file-references' is non-nil to cache
|
|
labels from multiple files in a project.")
|
|
|
|
|
|
(defvar org-ref-file-timestamps (make-hash-table :test 'equal)
|
|
"Hash table mapping file-path -> (mtime . size) for change detection.
|
|
Used to determine if a file needs to be re-scanned for labels without
|
|
actually opening and parsing the file.")
|
|
|
|
|
|
(defun org-ref-get-included-files ()
|
|
"Return list of absolute paths to files included in current buffer.
|
|
Parses #+INCLUDE directives and returns a list of existing files.
|
|
Only returns files that actually exist on disk."
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(let ((files '()))
|
|
(while (re-search-forward "^[ \t]*#\\+INCLUDE:[ \t]+\"\\([^\"]+\\)\"" nil t)
|
|
(let* ((file (match-string-no-properties 1))
|
|
(expanded-file (expand-file-name file)))
|
|
(when (file-exists-p expanded-file)
|
|
(push expanded-file files))))
|
|
(nreverse files))))
|
|
|
|
|
|
(defun org-ref-file-changed-p (file)
|
|
"Check if FILE has changed since last scan using timestamp and size.
|
|
This is an O(1) operation that doesn't require parsing the file.
|
|
Returns t if the file has changed or hasn't been scanned yet."
|
|
(let* ((attrs (file-attributes file))
|
|
(mtime (nth 5 attrs))
|
|
(size (nth 7 attrs))
|
|
(cached (gethash file org-ref-file-timestamps)))
|
|
(or (not cached)
|
|
(not (equal mtime (car cached)))
|
|
(not (equal size (cdr cached))))))
|
|
|
|
|
|
(defun org-ref-mark-file-scanned (file)
|
|
"Record timestamp and size of FILE to detect future changes."
|
|
(let* ((attrs (file-attributes file))
|
|
(mtime (nth 5 attrs))
|
|
(size (nth 7 attrs)))
|
|
(puthash file (cons mtime size) org-ref-file-timestamps)))
|
|
|
|
|
|
(defun org-ref-scan-buffer-for-labels ()
|
|
"Scan current buffer for labels and return list of (label . context) cons cells.
|
|
This is the core scanning logic used by both single-file and multi-file modes."
|
|
(let ((case-fold-search t)
|
|
(rx (string-join org-ref-ref-label-regexps "\\|"))
|
|
(labels '())
|
|
oe ;; org-element
|
|
context)
|
|
(save-excursion
|
|
(org-with-wide-buffer
|
|
(goto-char (point-min))
|
|
(while (re-search-forward rx nil t)
|
|
(save-match-data
|
|
;; Here we try to get some relevant context for different things you
|
|
;; might reference.
|
|
(setq oe (org-element-context)
|
|
context (string-trim
|
|
(pcase (car oe)
|
|
('latex-environment (buffer-substring
|
|
(org-element-property :begin oe)
|
|
(org-element-property :end oe)))
|
|
;; figure
|
|
('paragraph (buffer-substring
|
|
(org-element-property :begin oe)
|
|
(org-element-property :end oe)))
|
|
('table (buffer-substring
|
|
(org-element-property :begin oe)
|
|
(org-element-property :end oe)))
|
|
;; Headings fall here.
|
|
(_ (buffer-substring (line-beginning-position)
|
|
(line-end-position)))))))
|
|
(cl-pushnew (cons (match-string-no-properties 1) context)
|
|
labels))))
|
|
;; reverse so they are in the order we find them.
|
|
(delete-dups (reverse labels))))
|
|
|
|
|
|
(defun org-ref-get-labels-single-file ()
|
|
"Get labels from current buffer only (original single-file behavior).
|
|
Uses buffer-local cache and buffer-chars-modified-tick for invalidation."
|
|
(if (or
|
|
;; if we have not checked we have to check
|
|
(null org-ref-buffer-chars-modified-tick)
|
|
;; Now check if buffer has changed since last time we looked. We check
|
|
;; this with the buffer-chars-modified-tick which keeps track of changes.
|
|
;; If this hasn't changed, no chars have been modified.
|
|
(not (= (buffer-chars-modified-tick)
|
|
org-ref-buffer-chars-modified-tick)))
|
|
;; We need to search for all the labels either because we don't have them,
|
|
;; or the buffer has changed since we looked last time.
|
|
(setq
|
|
org-ref-buffer-chars-modified-tick (buffer-chars-modified-tick)
|
|
org-ref-label-cache (org-ref-scan-buffer-for-labels))
|
|
;; retrieve the cached data
|
|
org-ref-label-cache))
|
|
|
|
|
|
(defun org-ref-scan-file-for-labels (file)
|
|
"Scan FILE for labels and return list of (label . context) cons cells.
|
|
Opens the file in a temporary buffer and scans it."
|
|
(with-temp-buffer
|
|
(insert-file-contents file)
|
|
(org-mode)
|
|
(org-ref-scan-buffer-for-labels)))
|
|
|
|
|
|
(defun org-ref-get-labels-multi-file ()
|
|
"Get labels from current file and all included files.
|
|
Only re-scans files that have actually changed (timestamp-based detection).
|
|
Uses global project cache for efficiency."
|
|
(when (buffer-file-name)
|
|
(let* ((current-file (buffer-file-name))
|
|
(included-files (org-ref-get-included-files))
|
|
(all-files (cons current-file included-files))
|
|
(all-labels '()))
|
|
|
|
;; For each file, check if it changed and re-scan only if needed
|
|
(dolist (file all-files)
|
|
(when (org-ref-file-changed-p file)
|
|
;; File changed, re-scan it
|
|
(let ((file-labels (if (string= file current-file)
|
|
;; For current file, use the regular scan
|
|
(org-ref-scan-buffer-for-labels)
|
|
;; For included files, scan from disk
|
|
(org-ref-scan-file-for-labels file))))
|
|
;; Cache the labels for this file
|
|
(puthash file file-labels org-ref-project-label-cache)
|
|
;; Mark file as scanned
|
|
(org-ref-mark-file-scanned file)))
|
|
|
|
;; Retrieve cached labels for this file
|
|
(let ((file-labels (gethash file org-ref-project-label-cache)))
|
|
(when file-labels
|
|
(setq all-labels (append all-labels file-labels)))))
|
|
|
|
;; Remove duplicates (in case same label appears in multiple files)
|
|
(delete-dups all-labels))))
|
|
|
|
|
|
(defun org-ref-get-labels ()
|
|
"Return a list of referenceable labels in the document.
|
|
You can reference:
|
|
A NAME keyword
|
|
A CUSTOM_ID property on a heading
|
|
A LaTeX label
|
|
A target.
|
|
A label link
|
|
A setting in lstset
|
|
|
|
See `org-ref-ref-label-regexps' for the patterns that find these.
|
|
|
|
Returns a list of cons cells (label . context).
|
|
|
|
If `org-ref-enable-multi-file-references' is non-nil, also includes
|
|
labels from files referenced via #+INCLUDE directives.
|
|
|
|
It is important for this function to be fast, since we use it in
|
|
font-lock."
|
|
(if org-ref-enable-multi-file-references
|
|
(org-ref-get-labels-multi-file)
|
|
(org-ref-get-labels-single-file)))
|
|
|
|
|
|
(defun org-ref-find-label-in-buffer (label)
|
|
"Search for LABEL in current buffer.
|
|
Returns t if found and moves point to the label, nil otherwise."
|
|
(let ((case-fold-search t)
|
|
(rx (string-join org-ref-ref-label-regexps "\\|")))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(catch 'found
|
|
(while (re-search-forward rx nil t)
|
|
(when (string= label (match-string-no-properties 1))
|
|
(goto-char (match-beginning 1))
|
|
(throw 'found t)))))))
|
|
|
|
|
|
(defun org-ref-find-label-in-file (label file)
|
|
"Search for LABEL in FILE.
|
|
Returns the position if found, nil otherwise."
|
|
(with-current-buffer (find-file-noselect file)
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(let ((case-fold-search t)
|
|
(rx (string-join org-ref-ref-label-regexps "\\|")))
|
|
(catch 'found
|
|
(while (re-search-forward rx nil t)
|
|
(when (string= label (match-string-no-properties 1))
|
|
(throw 'found (match-beginning 1)))))))))
|
|
|
|
|
|
(defun org-ref-ref-jump-to (&optional path)
|
|
"Jump to the target for the ref link at point.
|
|
If `org-ref-enable-multi-file-references' is non-nil and the label
|
|
is not found in the current buffer, searches in included files."
|
|
(interactive)
|
|
(let ((case-fold-search t)
|
|
(label (get-text-property (point) 'org-ref-ref-label))
|
|
(labels (split-string path ","))
|
|
(rx (string-join org-ref-ref-label-regexps "\\|")))
|
|
(when (null label)
|
|
(pcase (length labels)
|
|
(1
|
|
(setq label (cl-first labels)))
|
|
(_
|
|
(setq label (completing-read "Label: " labels)))))
|
|
(when label
|
|
(org-mark-ring-push)
|
|
;; First, try to find in current buffer
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(let ((found nil))
|
|
(catch 'found
|
|
(while (re-search-forward rx nil t)
|
|
(when (string= label (match-string-no-properties 1))
|
|
(save-match-data (org-mark-ring-push))
|
|
(goto-char (match-beginning 1))
|
|
(org-fold-show-entry)
|
|
(message
|
|
(substitute-command-keys
|
|
"Go back with (org-mark-ring-goto) \\[org-mark-ring-goto]."))
|
|
(setq found t)
|
|
(throw 'found t))))
|
|
|
|
;; If not found in current buffer and multi-file mode is enabled,
|
|
;; search in included files
|
|
(when (and (not found)
|
|
org-ref-enable-multi-file-references
|
|
(buffer-file-name))
|
|
(let ((included-files (org-ref-get-included-files)))
|
|
(catch 'found-in-file
|
|
(dolist (file included-files)
|
|
(let ((pos (org-ref-find-label-in-file label file)))
|
|
(when pos
|
|
;; Found in an included file - open it and jump to position
|
|
(find-file file)
|
|
(goto-char pos)
|
|
(org-fold-show-entry)
|
|
(message
|
|
(substitute-command-keys
|
|
"Go back with (org-mark-ring-goto) \\[org-mark-ring-goto]."))
|
|
(throw 'found-in-file t)))))
|
|
|
|
;; If we get here, label wasn't found anywhere
|
|
(unless found
|
|
(message "Label '%s' not found in current file or included files" label))))))))
|
|
|
|
|
|
|
|
(defun org-ref-find-overlay-with-image (begin end)
|
|
"Find an overlay with an image display property between BEGIN and END.
|
|
Returns the image display spec or nil if none found."
|
|
(catch 'found
|
|
(let ((pos begin))
|
|
(while (< pos end)
|
|
(dolist (ov (overlays-at pos))
|
|
;; Check for org-mode preview overlay or math-preview overlay
|
|
(when (or (eq (overlay-get ov 'org-overlay-type) 'org-latex-overlay)
|
|
(overlay-get ov 'preview-image))
|
|
(let ((display (overlay-get ov 'display)))
|
|
(when (and display (listp display) (eq (car display) 'image))
|
|
(throw 'found display)))))
|
|
(setq pos (next-overlay-change pos))))
|
|
nil))
|
|
|
|
|
|
(defun org-ref-get-preview-image-at-label (label)
|
|
"Return the preview image display spec for LABEL if it exists.
|
|
Searches for LABEL in the buffer (both \\label{LABEL} and #+name: LABEL forms)
|
|
and checks if there is an org-latex preview overlay at that location.
|
|
Returns the image display spec that can be used in a propertized string,
|
|
or nil if no preview exists.
|
|
|
|
Uses caching for performance - cache is invalidated when buffer is modified."
|
|
;; Check cache first
|
|
(let ((cached (and org-ref-preview-image-cache
|
|
(equal org-ref-preview-cache-tick (buffer-chars-modified-tick))
|
|
(assoc label org-ref-preview-image-cache))))
|
|
(if cached
|
|
(cdr cached)
|
|
;; Not in cache, search for it
|
|
(let ((image-spec
|
|
(save-excursion
|
|
(save-restriction
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(or
|
|
;; Try 1: Search for \label{LABEL} in LaTeX environments
|
|
(when (re-search-forward (format "\\\\label{%s}" (regexp-quote label)) nil t)
|
|
(let* ((elem (org-element-context))
|
|
(begin (org-element-property :begin elem))
|
|
(end (org-element-property :end elem)))
|
|
(when (and begin end (eq (org-element-type elem) 'latex-environment))
|
|
(org-ref-find-overlay-with-image begin end))))
|
|
|
|
;; Try 2: Search for #+name: LABEL before latex-environment
|
|
(progn
|
|
(goto-char (point-min))
|
|
(when (re-search-forward (format "^[ \t]*#\\+name:[ \t]+%s[ \t]*$"
|
|
(regexp-quote label)) nil t)
|
|
(forward-line 1)
|
|
(let* ((elem (org-element-context))
|
|
(begin (org-element-property :begin elem))
|
|
(end (org-element-property :end elem)))
|
|
(when (and begin end (eq (org-element-type elem) 'latex-environment))
|
|
(org-ref-find-overlay-with-image begin end))))))))))
|
|
|
|
;; Update cache
|
|
(when (or (null org-ref-preview-cache-tick)
|
|
(not (equal org-ref-preview-cache-tick (buffer-chars-modified-tick))))
|
|
(setq org-ref-preview-image-cache nil
|
|
org-ref-preview-cache-tick (buffer-chars-modified-tick)))
|
|
|
|
;; Add to cache (even if nil, to avoid repeated searches)
|
|
(push (cons label image-spec) org-ref-preview-image-cache)
|
|
|
|
image-spec))))
|
|
|
|
|
|
(defun org-ref-ref-help-echo (_win _obj position)
|
|
"Tooltip for context on a ref label with optional image support.
|
|
POSITION is the point under the mouse.
|
|
|
|
Strategy: If previews exist on equations, show them in the minibuffer.
|
|
Otherwise show text.
|
|
|
|
When `org-ref-show-equation-images-in-tooltips' is non-nil and running in
|
|
GUI Emacs, checks if a preview image exists for the referenced equation.
|
|
If found, displays the image in the minibuffer using message. Otherwise,
|
|
displays the LaTeX text context as usual.
|
|
|
|
Always returns a string (empty string if no context is found)."
|
|
(let* ((label (get-text-property position 'org-ref-ref-label))
|
|
(context (cdr (assoc label (org-ref-get-labels))))
|
|
(fallback (if label
|
|
(format "Reference to %s" label)
|
|
"")))
|
|
;; Try to show image if conditions are met
|
|
(or (if (and org-ref-show-equation-images-in-tooltips
|
|
label
|
|
(display-graphic-p)) ; Images only work in GUI
|
|
;; Try to find and display preview image
|
|
(let ((image-spec (org-ref-get-preview-image-at-label label)))
|
|
(if image-spec
|
|
;; Extract file from the overlay's image spec
|
|
(let ((file (plist-get (cdr image-spec) :file)))
|
|
;; Only show image if file exists
|
|
(if (and file (file-exists-p file))
|
|
(condition-case nil
|
|
;; Show image in minibuffer using message
|
|
;; Use the same image-spec from the overlay to preserve size
|
|
(progn
|
|
(message "%s" (propertize " " 'display image-spec))
|
|
;; Still return context for any fallback tooltip
|
|
context)
|
|
;; If image display fails, show text
|
|
(error context))
|
|
;; File doesn't exist, show text
|
|
context))
|
|
;; No image spec found, show text
|
|
context))
|
|
;; Feature disabled or not in GUI, show text
|
|
context)
|
|
;; Fallback when context is nil
|
|
fallback)))
|
|
|
|
|
|
(defun org-ref-ref-activate (start _end path _bracketp)
|
|
"Activate a ref link.
|
|
The PATH should be a comma-separated list of labels.
|
|
Argument START is the start of the link.
|
|
Argument END is the end of the link."
|
|
(when org-ref-activate-ref-links
|
|
(let ((labels (mapcar 'car (org-ref-get-labels))))
|
|
(goto-char start)
|
|
(cl-loop for label in (split-string path ",") do
|
|
(search-forward label)
|
|
;; store property so we can follow it later.
|
|
(put-text-property (match-beginning 0)
|
|
(match-end 0)
|
|
'org-ref-ref-label
|
|
label)
|
|
|
|
(unless (member label labels)
|
|
|
|
(put-text-property (match-beginning 0)
|
|
(match-end 0)
|
|
'face
|
|
'font-lock-warning-face)
|
|
(put-text-property (match-beginning 0)
|
|
(match-end 0)
|
|
'help-echo
|
|
"Label not found"))))))
|
|
|
|
|
|
(defun org-ref-ref-export (cmd keyword _desc backend)
|
|
"An export function for ref links.
|
|
Argument CMD is the LaTeX command to export to.
|
|
Argument KEYWORD is the path of the ref link.
|
|
Argument BACKEND is the export backend.
|
|
This is meant to be used with `apply-partially' in the link definitions."
|
|
(cond
|
|
((eq backend 'latex)
|
|
(format "\\%s{%s}" cmd keyword))))
|
|
|
|
|
|
(defun org-ref-complete-link (refstyle &optional _arg)
|
|
"Complete a ref link to an existing label."
|
|
(concat refstyle ":" (completing-read "Label: " (org-ref-get-labels))))
|
|
|
|
|
|
(defun org-ref-store-ref-link (&optional reftype)
|
|
"Store a ref link to a label. The output will be a ref to that label."
|
|
;; First we have to make sure we are on a label link.
|
|
(unless reftype (setq reftype "ref"))
|
|
(let* ((object (and (eq major-mode 'org-mode) (org-element-context)))
|
|
(label (cond
|
|
;; here literally on a label link.
|
|
((and
|
|
(equal (org-element-type object) 'link)
|
|
(equal (org-element-property :type object) "label"))
|
|
(org-element-property :path object))
|
|
|
|
;; here on a file link. if it has a caption with a label in it, we store
|
|
;; it.
|
|
((and
|
|
(equal (org-element-type object) 'link)
|
|
(equal (org-element-property :type object) "file")
|
|
(org-file-image-p (org-element-property :path object)))
|
|
|
|
(if (org-element-property :name object)
|
|
(org-element-property :name object)
|
|
;; maybe we have a caption to get it from.
|
|
(let* ((parent (org-element-property :parent object)))
|
|
(when (and parent
|
|
(equal (org-element-type parent) 'paragraph))
|
|
(if (org-element-property :name parent)
|
|
;; caption paragraph may have a name which we use if it is there
|
|
(org-element-property :name parent)
|
|
;; else search caption
|
|
(let ((caption (string-join
|
|
(mapcar 'org-no-properties
|
|
(org-export-get-caption parent))
|
|
"")))
|
|
(when (string-match org-ref-label-re caption)
|
|
(match-string 1 caption))))))))
|
|
|
|
;; here on a paragraph (eg in a caption of an image). it is a paragraph with a caption
|
|
;; in a caption, with no name, but maybe a label
|
|
((equal (org-element-type object) 'paragraph)
|
|
(if (org-element-property :name object)
|
|
(org-element-property :name object)
|
|
|
|
;; See if it is in the caption name
|
|
(let ((caption (string-join (mapcar 'org-no-properties
|
|
(org-export-get-caption object)) "")))
|
|
(when (string-match org-ref-label-re caption)
|
|
(match-string 1 caption)))))
|
|
|
|
;; If you are in a table, we need to be at the beginning to
|
|
;; make sure we get the name. Note when in a caption it appears
|
|
;; you are in a table but org-at-table-p is nil there.
|
|
((or (equal (org-element-type object) 'table) (org-at-table-p))
|
|
(save-excursion
|
|
(goto-char (org-table-begin))
|
|
(let* ((table (org-element-context))
|
|
(label (org-element-property :name table))
|
|
(caption (string-join "" (mapcar 'org-no-properties
|
|
(org-export-get-caption table)))))
|
|
(when (null label)
|
|
;; maybe there is a label in the caption?
|
|
(when (string-match org-ref-label-link-re caption)
|
|
(match-string 1 caption))))))
|
|
|
|
;; and to #+namel: lines
|
|
((and (equal (org-element-type object) 'paragraph)
|
|
(org-element-property :name object))
|
|
(org-element-property :name object))
|
|
|
|
;; in a latex environment
|
|
((equal (org-element-type object) 'latex-environment)
|
|
(let ((value (org-element-property :value object)))
|
|
(when (string-match "\\\\label{\\(?1:[+a-zA-Z0-9:\\._-]*\\)}" value)
|
|
(match-string-no-properties 1 value))))
|
|
|
|
;; Match targets, like <<label>>
|
|
((equal (org-element-type object) 'target)
|
|
(org-element-property :value object))
|
|
|
|
(t
|
|
nil))))
|
|
|
|
(when label
|
|
(org-link-store-props
|
|
:type reftype
|
|
:link (concat reftype ":" label))
|
|
t)))
|
|
|
|
|
|
;; ** ref link
|
|
|
|
(org-link-set-parameters "ref"
|
|
:store (defun org-ref-store-ref () (org-ref-store-ref-link "ref"))
|
|
:complete (apply-partially #'org-ref-complete-link "ref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "ref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
;;** pageref link
|
|
|
|
(org-link-set-parameters "pageref"
|
|
:store (defun org-ref-store-pageref () (org-ref-store-ref-link "pageref"))
|
|
:complete (apply-partially #'org-ref-complete-link "pageref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "pageref")
|
|
:face 'org-ref-ref-face
|
|
:complete (lambda (&optional arg) (org-ref-complete-link arg "pageref"))
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
;;** nameref link
|
|
|
|
(org-link-set-parameters "nameref"
|
|
:store (defun org-ref-store-nameref () (org-ref-store-ref-link "nameref"))
|
|
:complete (apply-partially #'org-ref-complete-link "nameref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "nameref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
;;** eqref link
|
|
|
|
(org-link-set-parameters "eqref"
|
|
:store (defun org-ref-store-eqref () (org-ref-store-ref-link "eqref"))
|
|
:complete (apply-partially #'org-ref-complete-link "eqref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "eqref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
;;** autoref link
|
|
|
|
(org-link-set-parameters "autoref"
|
|
:store (defun org-ref-store-autoref () (org-ref-store-ref-link "autoref"))
|
|
:complete (apply-partially #'org-ref-complete-link "autoref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "autoref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
(org-link-set-parameters "Autoref"
|
|
:store (defun org-ref-store-Autoref () (org-ref-store-ref-link "Autoref"))
|
|
:complete (apply-partially #'org-ref-complete-link "Autoref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "Autoref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
;;** cref link
|
|
;; for LaTeX cleveref package:
|
|
;; https://www.ctan.org/tex-archive/macros/latex/contrib/cleveref
|
|
|
|
|
|
(org-link-set-parameters "cref"
|
|
:store (defun org-ref-store-cref () (org-ref-store-ref-link "cref"))
|
|
:complete (apply-partially #'org-ref-complete-link "cref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "cref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
(org-link-set-parameters "Cref"
|
|
:store (defun org-ref-store-Cref () (org-ref-store-ref-link "Cref"))
|
|
:complete (apply-partially #'org-ref-complete-link "Cref")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export (apply-partially #'org-ref-ref-export "Cref")
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
(defun org-ref-crefrange-export (path _desc backend)
|
|
(pcase backend
|
|
('latex
|
|
(let ((labels (split-string path ",")))
|
|
(format "\\crefrange{%s}{%s}" (cl-first labels) (cl-second labels))))))
|
|
|
|
|
|
(defun org-ref-Crefrange-export (path _desc backend)
|
|
(pcase backend
|
|
('latex
|
|
(let ((labels (split-string path ",")))
|
|
(format "\\Crefrange{%s}{%s}" (cl-first labels) (cl-second labels))))))
|
|
|
|
|
|
(defun org-ref-crefrange-complete (cmd &optional _arg)
|
|
"Completing function for the c/Crefrange links."
|
|
(concat cmd ":"
|
|
(completing-read "Label 1: " (org-ref-get-labels))
|
|
","
|
|
(completing-read "Label 2: " (org-ref-get-labels))))
|
|
|
|
|
|
(org-link-set-parameters "crefrange"
|
|
:complete (apply-partially #'org-ref-crefrange-complete "crefrange")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export #'org-ref-crefrange-export
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
(org-link-set-parameters "Crefrange"
|
|
:complete (apply-partially #'org-ref-crefrange-complete "Crefrange")
|
|
:activate-func #'org-ref-ref-activate
|
|
:follow #'org-ref-ref-jump-to
|
|
:export #'org-ref-Crefrange-export
|
|
:face 'org-ref-ref-face
|
|
:help-echo #'org-ref-ref-help-echo)
|
|
|
|
|
|
;; ** remove store functions
|
|
(defun org-ref-ref-remove-store ()
|
|
"Remove the store functions from ref links.
|
|
These tend to clobber the org store links. You can use C-u C-u
|
|
C-c C-l to not use them, but if you prefer not to use them, this
|
|
function removes the store functions from the links."
|
|
(interactive)
|
|
(cl-loop for reflink in '("ref" "pageref" "nameref" "eqref" "autoref" "Autoref"
|
|
"cref" "Cref" "crefrange" "Crefrange")
|
|
do
|
|
(setf (cdr (assoc reflink org-link-parameters))
|
|
(org-plist-delete (cdr (assoc reflink org-link-parameters)) :store))))
|
|
|
|
;; * Insert link
|
|
(defvar org-ref-equation-environments
|
|
'("equation"
|
|
"equation*"
|
|
"align"
|
|
"align*"
|
|
"multline"
|
|
"multline*")
|
|
"LaTeX environments that should be treated as equations when referencing.")
|
|
|
|
|
|
(defvar org-ref-ref-type-inference-alist
|
|
'((org-ref-equation-label-p . "eqref"))
|
|
"Alist of predicate functions taking a label name and the
|
|
desired reference type if the predicate returns true.")
|
|
|
|
|
|
(defun org-ref-enclosing-environment (label)
|
|
"Returns the name of the innermost LaTeX environment containing
|
|
the first instance of the label, or nil of there is none."
|
|
(or
|
|
(save-excursion
|
|
(save-restriction
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(let ((label-point (search-forward (format "\\label{%s}" label) nil t)))
|
|
(when label-point
|
|
(catch 'return
|
|
(let (last-begin-point last-env)
|
|
(while (setq
|
|
last-begin-point (re-search-backward "\\\\begin{\\([^}]+\\)}" nil t)
|
|
last-env (match-string-no-properties 1))
|
|
(let ((env-end-point
|
|
(search-forward (format "\\end{%s}" last-env) nil t)))
|
|
(if (and env-end-point
|
|
(> env-end-point label-point))
|
|
(throw 'return last-env)
|
|
(goto-char last-begin-point))))))))))
|
|
;; Check latex-environments for names, and matching environment
|
|
(org-element-map (org-element-parse-buffer) 'latex-environment
|
|
(lambda (le)
|
|
(when (and (string= label (org-element-property :name le))
|
|
(string-match
|
|
(concat "begin{\\("
|
|
(regexp-opt org-ref-equation-environments)
|
|
"\\)}")
|
|
(org-element-property :value le)))
|
|
(match-string 1 (org-element-property :value le))))
|
|
nil t)))
|
|
|
|
|
|
(defun org-ref-equation-label-p (label)
|
|
"Return non-nil if LABEL is an equation label."
|
|
(let ((maybe-env (org-ref-enclosing-environment label)))
|
|
(when maybe-env
|
|
(member maybe-env org-ref-equation-environments))))
|
|
|
|
|
|
(defun org-ref-infer-ref-type (label)
|
|
"Return inferred type for LABEL."
|
|
(or (cl-dolist (pred-pair org-ref-ref-type-inference-alist)
|
|
(when (funcall (car pred-pair) label)
|
|
(cl-return (eval (cdr pred-pair)))))
|
|
org-ref-default-ref-type))
|
|
|
|
|
|
(defun org-ref-ref-link-p ()
|
|
"Return the link at point if point is on a ref link."
|
|
(let ((el (org-element-context)))
|
|
(and (eq (org-element-type el) 'link)
|
|
(assoc (org-element-property :type el) org-ref-ref-types)
|
|
el)))
|
|
|
|
|
|
(defun org-ref-select-label ()
|
|
"Select a label in the buffer with annotated completion."
|
|
(let* ((type-annotation (lambda (s)
|
|
(let ((item (assoc s minibuffer-completion-table)))
|
|
(when item
|
|
(with-temp-buffer
|
|
(insert "\n" (cdr item))
|
|
(indent-rigidly (point-min) (point-max) 20)
|
|
(buffer-string))))))
|
|
(completion-extra-properties `(:annotation-function ,type-annotation)))
|
|
(completing-read "Label: " (org-ref-get-labels))))
|
|
|
|
|
|
(defun org-ref-insert-ref-link (&optional set-type)
|
|
"Insert a ref link.
|
|
If on a link, append a label to the end.
|
|
With a prefix arg SET-TYPE choose the ref type."
|
|
(interactive "P")
|
|
(let* ((minibuffer-setup-hook '(org-ref-minibuffer-prefix))
|
|
(label (org-ref-select-label))
|
|
(type (if (or set-type org-ref-prefix-arg)
|
|
(org-ref-select-ref-type)
|
|
;; in general, we prefer to infer the type, so that equations
|
|
;; get a better default. However, if you customize
|
|
;; `org-ref-default-ref-type', we use that instead. The most
|
|
;; common use case for this is setting that variable to cref,
|
|
;; which does its own automatic inference of the type.
|
|
(if (string= "ref" org-ref-default-ref-type)
|
|
(org-ref-infer-ref-type label)
|
|
org-ref-default-ref-type))))
|
|
(if-let* ((lnk (org-ref-ref-link-p))
|
|
(path (org-element-property :path lnk))
|
|
(beg (org-element-property :begin lnk))
|
|
(end (org-element-property :end lnk)))
|
|
(progn
|
|
(setf (plist-get (cadr lnk) :path) (concat path "," label))
|
|
(cl--set-buffer-substring beg end (org-element-interpret-data lnk)))
|
|
|
|
(insert (format "%s:%s" type label)))
|
|
(goto-char (org-element-property :end (org-element-context)))))
|
|
|
|
|
|
(provide 'org-ref-ref-links)
|
|
|
|
;;; org-ref-ref-links.el ends here
|