| commit | author | age | ||
| 76bbd0 | 1 | ;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2009-2018 Free Software Foundation, Inc. | |
| 4 | ||
| 5 | ;; Authors: Eric Schulte | |
| 6 | ;; Dan Davison | |
| 7 | ;; Keywords: literate programming, reproducible research | |
| 8 | ;; Homepage: https://orgmode.org | |
| 9 | ||
| 10 | ;; This file is part of GNU Emacs. | |
| 11 | ||
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 13 | ;; it under the terms of the GNU General Public License as published by | |
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 15 | ;; (at your option) any later version. | |
| 16 | ||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;; GNU General Public License for more details. | |
| 21 | ||
| 22 | ;; You should have received a copy of the GNU General Public License | |
| 23 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | |
| 24 | ||
| 25 | ;;; Commentary: | |
| 26 | ||
| 27 | ;; Functions for referencing data from the header arguments of a | |
| 28 | ;; org-babel block. The syntax of such a reference should be | |
| 29 | ||
| 30 | ;; #+VAR: variable-name=file:resource-id | |
| 31 | ||
| 32 | ;; - variable-name :: the name of the variable to which the value | |
| 33 | ;; will be assigned | |
| 34 | ||
| 35 | ;; - file :: path to the file containing the resource, or omitted if | |
| 36 | ;; resource is in the current file | |
| 37 | ||
| 38 | ;; - resource-id :: the id or name of the resource | |
| 39 | ||
| 40 | ;; So an example of a simple src block referencing table data in the | |
| 41 | ;; same file would be | |
| 42 | ||
| 43 | ;; #+NAME: sandbox | |
| 44 | ;; | 1 | 2 | 3 | | |
| 45 | ;; | 4 | org-babel | 6 | | |
| 46 | ;; | |
| 47 | ;; #+begin_src emacs-lisp :var table=sandbox | |
| 48 | ;; (message table) | |
| 49 | ;; #+end_src | |
| 50 | ||
| 51 | ;;; Code: | |
| 52 | (require 'ob-core) | |
| 53 | (require 'cl-lib) | |
| 54 | ||
| 55 | (declare-function org-babel-lob-get-info "ob-lob" (&optional datum)) | |
| 56 | (declare-function org-element-at-point "org-element" ()) | |
| 57 | (declare-function org-element-property "org-element" (property element)) | |
| 58 | (declare-function org-element-type "org-element" (element)) | |
| 59 | (declare-function org-end-of-meta-data "org" (&optional full)) | |
| 60 | (declare-function org-find-property "org" (property &optional value)) | |
| 61 | (declare-function org-id-find-id-file "org-id" (id)) | |
| 62 | (declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) | |
| 63 | (declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) | |
| 64 | (declare-function org-narrow-to-subtree "org" ()) | |
| 65 | (declare-function org-show-context "org" (&optional key)) | |
| 66 | (declare-function org-trim "org" (s &optional keep-lead)) | |
| 67 | ||
| 68 | (defvar org-babel-update-intermediate nil | |
| 69 | "Update the in-buffer results of code blocks executed to resolve references.") | |
| 70 | ||
| 71 | (defun org-babel-ref-parse (assignment) | |
| 72 | "Parse a variable ASSIGNMENT in a header argument. | |
| 73 | ||
| 74 | If the right hand side of the assignment has a literal value | |
| 75 | return that value, otherwise interpret it as a reference to an | |
| 76 | external resource and find its value using `org-babel-ref-resolve'. | |
| 77 | ||
| 78 | Return a list with two elements: the name of the variable, and an | |
| 79 | Emacs Lisp representation of the value of the variable." | |
| 80 | (when (string-match "\\(.+?\\)=" assignment) | |
| 81 | (let ((var (org-trim (match-string 1 assignment))) | |
| 82 | (ref (org-trim (substring assignment (match-end 0))))) | |
| 83 | (cons (intern var) | |
| 84 | (let ((out (save-excursion | |
| 85 | (when org-babel-current-src-block-location | |
| 86 | (goto-char (if (markerp org-babel-current-src-block-location) | |
| 87 | (marker-position org-babel-current-src-block-location) | |
| 88 | org-babel-current-src-block-location))) | |
| 89 | (org-babel-read ref)))) | |
| 90 | (if (equal out ref) | |
| 91 | (if (and (string-prefix-p "\"" ref) | |
| 92 | (string-suffix-p "\"" ref)) | |
| 93 | (read ref) | |
| 94 | (org-babel-ref-resolve ref)) | |
| 95 | out)))))) | |
| 96 | ||
| 97 | (defun org-babel-ref-goto-headline-id (id) | |
| 98 | (or (let ((h (org-find-property "CUSTOM_ID" id))) | |
| 99 | (when h (goto-char h))) | |
| 100 | (let* ((file (org-id-find-id-file id)) | |
| 101 | (m (when file (org-id-find-id-in-file id file 'marker)))) | |
| 102 | (when (and file m) | |
| 103 | (message "file:%S" file) | |
| 104 | (pop-to-buffer-same-window (marker-buffer m)) | |
| 105 | (goto-char m) | |
| 106 | (move-marker m nil) | |
| 107 | (org-show-context) | |
| 108 | t)))) | |
| 109 | ||
| 110 | (defun org-babel-ref-headline-body () | |
| 111 | (save-restriction | |
| 112 | (org-narrow-to-subtree) | |
| 113 | (buffer-substring | |
| 114 | (save-excursion (goto-char (point-min)) | |
| 115 | (org-end-of-meta-data) | |
| 116 | (point)) | |
| 117 | (point-max)))) | |
| 118 | ||
| 119 | (defvar org-babel-library-of-babel) | |
| 120 | (defun org-babel-ref-resolve (ref) | |
| 121 | "Resolve the reference REF and return its value." | |
| 122 | (save-window-excursion | |
| 123 | (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer)) | |
| 124 | (save-excursion | |
| 125 | (let ((case-fold-search t) | |
| 126 | args new-refere new-header-args new-referent split-file split-ref | |
| 127 | index) | |
| 128 | ;; if ref is indexed grab the indices -- beware nested indices | |
| 129 | (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) | |
| 130 | (let ((str (substring ref 0 (match-beginning 0)))) | |
| 131 | (= (cl-count ?\( str) (cl-count ?\) str)))) | |
| 132 | (setq index (match-string 1 ref)) | |
| 133 | (setq ref (substring ref 0 (match-beginning 0)))) | |
| 134 | ;; assign any arguments to pass to source block | |
| 135 | (when (string-match | |
| 136 | "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\(.*\\))$" ref) | |
| 137 | (setq new-refere (match-string 1 ref)) | |
| 138 | (setq new-header-args (match-string 3 ref)) | |
| 139 | (setq new-referent (match-string 5 ref)) | |
| 140 | (when (> (length new-refere) 0) | |
| 141 | (when (> (length new-referent) 0) | |
| 142 | (setq args (mapcar (lambda (ref) (cons :var ref)) | |
| 143 | (org-babel-ref-split-args new-referent)))) | |
| 144 | (when (> (length new-header-args) 0) | |
| 145 | (setq args (append (org-babel-parse-header-arguments | |
| 146 | new-header-args) args))) | |
| 147 | (setq ref new-refere))) | |
| 148 | (when (string-match "^\\(.+\\):\\(.+\\)$" ref) | |
| 149 | (setq split-file (match-string 1 ref)) | |
| 150 | (setq split-ref (match-string 2 ref)) | |
| 151 | (find-file split-file) | |
| 152 | (setq ref split-ref)) | |
| 153 | (org-with-wide-buffer | |
| 154 | (goto-char (point-min)) | |
| 155 | (let* ((params (append args '((:results . "silent")))) | |
| 156 | (regexp (org-babel-named-data-regexp-for-name ref)) | |
| 157 | (result | |
| 158 | (catch :found | |
| 159 | ;; Check for code blocks or named data. | |
| 160 | (while (re-search-forward regexp nil t) | |
| 161 | ;; Ignore COMMENTed headings and orphaned | |
| 162 | ;; affiliated keywords. | |
| 163 | (unless (org-in-commented-heading-p) | |
| 164 | (let ((e (org-element-at-point))) | |
| 165 | (when (equal (org-element-property :name e) ref) | |
| 166 | (goto-char | |
| 167 | (org-element-property :post-affiliated e)) | |
| 168 | (pcase (org-element-type e) | |
| 169 | (`babel-call | |
| 170 | (throw :found | |
| 171 | (org-babel-execute-src-block | |
| 172 | nil (org-babel-lob-get-info e) params))) | |
| 173 | (`src-block | |
| 174 | (throw :found | |
| 175 | (org-babel-execute-src-block | |
| 176 | nil nil | |
| 177 | (and | |
| 178 | (not org-babel-update-intermediate) | |
| 179 | params)))) | |
| 180 | ((and (let v (org-babel-read-element e)) | |
| 181 | (guard v)) | |
| 182 | (throw :found v)) | |
| 183 | (_ (error "Reference not found"))))))) | |
| 184 | ;; Check for local or global headlines by ID. | |
| 185 | (when (org-babel-ref-goto-headline-id ref) | |
| 186 | (throw :found (org-babel-ref-headline-body))) | |
| 187 | ;; Check the Library of Babel. | |
| 188 | (let ((info (cdr (assq (intern ref) | |
| 189 | org-babel-library-of-babel)))) | |
| 190 | (when info | |
| 191 | (throw :found | |
| 192 | (org-babel-execute-src-block nil info params)))) | |
| 193 | (error "Reference `%s' not found in this buffer" ref)))) | |
| 194 | (cond | |
| 195 | ((symbolp result) (format "%S" result)) | |
| 196 | ((and index (listp result)) | |
| 197 | (org-babel-ref-index-list index result)) | |
| 198 | (t result))))))))) | |
| 199 | ||
| 200 | (defun org-babel-ref-index-list (index lis) | |
| 201 | "Return the subset of LIS indexed by INDEX. | |
| 202 | ||
| 203 | Indices are 0 based and negative indices count from the end of | |
| 204 | LIS, so 0 references the first element of LIS and -1 references | |
| 205 | the last. If INDEX is separated by \",\"s then each \"portion\" | |
| 206 | is assumed to index into the next deepest nesting or dimension. | |
| 207 | ||
| 208 | A valid \"portion\" can consist of either an integer index, two | |
| 209 | integers separated by a \":\" in which case the entire range is | |
| 210 | returned, or an empty string or \"*\" both of which are | |
| 211 | interpreted to mean the entire range and as such are equivalent | |
| 212 | to \"0:-1\"." | |
| 213 | (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) | |
| 214 | (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\\*\\)") | |
| 215 | (lgth (length lis)) | |
| 216 | (portion (match-string 1 index)) | |
| 217 | (remainder (substring index (match-end 0))) | |
| 218 | (wrap (lambda (num) (if (< num 0) (+ lgth num) num))) | |
| 219 | (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))) | |
| 220 | (funcall | |
| 221 | open | |
| 222 | (mapcar | |
| 223 | (lambda (sub-lis) | |
| 224 | (if (listp sub-lis) | |
| 225 | (org-babel-ref-index-list remainder sub-lis) | |
| 226 | sub-lis)) | |
| 227 | (if (or (= 0 (length portion)) (string-match ind-re portion)) | |
| 228 | (mapcar | |
| 229 | (lambda (n) (nth n lis)) | |
| 230 | (apply 'org-number-sequence | |
| 231 | (if (and (> (length portion) 0) (match-string 2 portion)) | |
| 232 | (list | |
| 233 | (funcall wrap (string-to-number (match-string 2 portion))) | |
| 234 | (funcall wrap (string-to-number (match-string 3 portion)))) | |
| 235 | (list (funcall wrap 0) (funcall wrap -1))))) | |
| 236 | (list (nth (funcall wrap (string-to-number portion)) lis)))))) | |
| 237 | lis)) | |
| 238 | ||
| 239 | (defun org-babel-ref-split-args (arg-string) | |
| 240 | "Split ARG-STRING into top-level arguments of balanced parenthesis." | |
| 241 | (mapcar #'org-trim (org-babel-balanced-split arg-string 44))) | |
| 242 | ||
| 243 | ||
| 244 | (provide 'ob-ref) | |
| 245 | ||
| 246 | ;;; ob-ref.el ends here | |
