lisp/ob-ref.el

   1 ;;; ob-ref.el --- org-babel functions for referencing external data
   2
   3 ;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
   4
   5 ;; Authors: Eric Schulte
   6 ;;       Dan Davison
   7 ;; Keywords: literate programming, reproducible research
   8 ;; Homepage: http://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 <http://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 (eval-when-compile
  54   (require 'cl))
  55
  56 (declare-function org-remove-if-not "org" (predicate seq))
  57 (declare-function org-at-table-p "org" (&optional table-type))
  58 (declare-function org-count "org" (CL-ITEM CL-SEQ))
  59 (declare-function org-at-item-p "org-list" ())
  60 (declare-function org-narrow-to-subtree "org" ())
  61 (declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
  62 (declare-function org-id-find-id-file "org-id" (id))
  63 (declare-function org-show-context "org" (&optional key))
  64 (declare-function org-pop-to-buffer-same-window
  65                   "org-compat" (&optional buffer-or-name norecord label))
  66 (declare-function org-babel-lob-execute "ob-lob" (info))
  67 (declare-function org-babel-lob-get-info "ob-lob" nil)
  68
  69 (defvar org-babel-ref-split-regexp
  70   "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
  71
  72 (defvar org-babel-update-intermediate nil
  73   "Update the in-buffer results of code blocks executed to resolve references.")
  74
  75 (defun org-babel-ref-parse (assignment)
  76   "Parse a variable ASSIGNMENT in a header argument.
  77 If the right hand side of the assignment has a literal value
  78 return that value, otherwise interpret as a reference to an
  79 external resource and find its value using
  80 `org-babel-ref-resolve'.  Return a list with two elements.  The
  81 first element of the list will be the name of the variable, and
  82 the second will be an emacs-lisp representation of the value of
  83 the variable."
  84   (when (string-match org-babel-ref-split-regexp assignment)
  85     (let ((var (match-string 1 assignment))
  86           (ref (match-string 2 assignment)))
  87       (cons (intern var)
  88             (let ((out (save-excursion
  89                          (when org-babel-current-src-block-location
  90                            (goto-char (if (markerp org-babel-current-src-block-location)
  91                                           (marker-position org-babel-current-src-block-location)
  92                                         org-babel-current-src-block-location)))
  93                          (org-babel-read ref))))
  94               (if (equal out ref)
  95                   (if (string-match "^\".*\"$" ref)
  96                       (read ref)
  97                     (org-babel-ref-resolve ref))
  98                 out))))))
  99
 100 (defun org-babel-ref-goto-headline-id (id)
 101   (goto-char (point-min))
 102   (let ((rx (regexp-quote id)))
 103     (or (re-search-forward
 104          (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t)
 105         (let* ((file (org-id-find-id-file id))
 106                (m (when file (org-id-find-id-in-file id file 'marker))))
 107           (when (and file m)
 108             (message "file:%S" file)
 109             (org-pop-to-buffer-same-window (marker-buffer m))
 110             (goto-char m)
 111             (move-marker m nil)
 112             (org-show-context)
 113             t)))))
 114
 115 (defun org-babel-ref-headline-body ()
 116   (save-restriction
 117     (org-narrow-to-subtree)
 118     (buffer-substring
 119      (save-excursion (goto-char (point-min))
 120                      (forward-line 1)
 121                      (when (looking-at "[ \t]*:PROPERTIES:")
 122                        (re-search-forward ":END:" nil)
 123                        (forward-char))
 124                      (point))
 125      (point-max))))
 126
 127 (defvar org-babel-lob-one-liner-regexp)
 128 (defvar org-babel-library-of-babel)
 129 (defun org-babel-ref-resolve (ref)
 130   "Resolve the reference REF and return its value."
 131   (save-window-excursion
 132     (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
 133       (save-excursion
 134         (let ((case-fold-search t)
 135               type args new-refere new-header-args new-referent result
 136               lob-info split-file split-ref index index-row index-col id)
 137           ;; if ref is indexed grab the indices -- beware nested indices
 138           (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
 139                      (let ((str (substring ref 0 (match-beginning 0))))
 140                        (= (org-count ?( str) (org-count ?) str))))
 141             (setq index (match-string 1 ref))
 142             (setq ref (substring ref 0 (match-beginning 0))))
 143           ;; assign any arguments to pass to source block
 144           (when (string-match
 145                  "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
 146             (setq new-refere      (match-string 1 ref))
 147             (setq new-header-args (match-string 3 ref))
 148             (setq new-referent    (match-string 5 ref))
 149             (when (> (length new-refere) 0)
 150               (when (> (length new-referent) 0)
 151                 (setq args (mapcar (lambda (ref) (cons :var ref))
 152                                    (org-babel-ref-split-args new-referent))))
 153               (when (> (length new-header-args) 0)
 154                 (setq args (append (org-babel-parse-header-arguments
 155                                     new-header-args) args)))
 156               (setq ref new-refere)))
 157           (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
 158             (setq split-file (match-string 1 ref))
 159             (setq split-ref (match-string 2 ref))
 160             (find-file split-file) (setq ref split-ref))
 161           (save-restriction
 162             (widen)
 163             (goto-char (point-min))
 164             (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
 165                       (res-rx (org-babel-named-data-regexp-for-name ref)))
 166                   ;; goto ref in the current buffer
 167                   (or
 168                    ;; check for code blocks
 169                    (re-search-forward src-rx nil t)
 170                    ;; check for named data
 171                    (re-search-forward res-rx nil t)
 172                    ;; check for local or global headlines by id
 173                    (setq id (org-babel-ref-goto-headline-id ref))
 174                    ;; check the Library of Babel
 175                    (setq lob-info (cdr (assoc (intern ref)
 176                                               org-babel-library-of-babel)))))
 177                 (unless (or lob-info id) (goto-char (match-beginning 0)))
 178               ;; ;; TODO: allow searching for names in other buffers
 179               ;; (setq id-loc (org-id-find ref 'marker)
 180               ;;       buffer (marker-buffer id-loc)
 181               ;;       loc (marker-position id-loc))
 182               ;; (move-marker id-loc nil)
 183               (error "Reference '%s' not found in this buffer" ref))
 184             (cond
 185              (lob-info (setq type 'lob))
 186              (id (setq type 'id))
 187              ((and (looking-at org-babel-src-name-regexp)
 188                    (save-excursion
 189                      (forward-line 1)
 190                      (or (looking-at org-babel-src-block-regexp)
 191                          (looking-at org-babel-multi-line-header-regexp))))
 192               (setq type 'source-block))
 193              ((and (looking-at org-babel-src-name-regexp)
 194                    (save-excursion
 195                      (forward-line 1)
 196                      (looking-at org-babel-lob-one-liner-regexp)))
 197               (setq type 'call-line))
 198              (t (while (not (setq type (org-babel-ref-at-ref-p)))
 199                   (forward-line 1)
 200                   (beginning-of-line)
 201                   (if (or (= (point) (point-min)) (= (point) (point-max)))
 202                       (error "Reference not found")))))
 203             (let ((params (append args '((:results . "silent")))))
 204               (setq result
 205                     (case type
 206                       (results-line (org-babel-read-result))
 207                       (table        (org-babel-read-table))
 208                       (list         (org-babel-read-list))
 209                       (file         (org-babel-read-link))
 210                       (source-block (org-babel-execute-src-block
 211                                      nil nil (if org-babel-update-intermediate
 212                                                  nil params)))
 213                       (call-line (save-excursion
 214                                    (forward-line 1)
 215                                    (org-babel-lob-execute
 216                                     (org-babel-lob-get-info))))
 217                       (lob          (org-babel-execute-src-block
 218                                      nil lob-info params))
 219                       (id           (org-babel-ref-headline-body)))))
 220             (if (symbolp result)
 221                 (format "%S" result)
 222               (if (and index (listp result))
 223                   (org-babel-ref-index-list index result)
 224                 result))))))))
 225
 226 (defun org-babel-ref-index-list (index lis)
 227   "Return the subset of LIS indexed by INDEX.
 228
 229 Indices are 0 based and negative indices count from the end of
 230 LIS, so 0 references the first element of LIS and -1 references
 231 the last.  If INDEX is separated by \",\"s then each \"portion\"
 232 is assumed to index into the next deepest nesting or dimension.
 233
 234 A valid \"portion\" can consist of either an integer index, two
 235 integers separated by a \":\" in which case the entire range is
 236 returned, or an empty string or \"*\" both of which are
 237 interpreted to mean the entire range and as such are equivalent
 238 to \"0:-1\"."
 239   (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index))
 240       (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
 241              (lgth (length lis))
 242              (portion (match-string 1 index))
 243              (remainder (substring index (match-end 0)))
 244              (wrap (lambda (num) (if (< num 0) (+ lgth num) num)))
 245              (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))))
 246         (funcall
 247          open
 248          (mapcar
 249           (lambda (sub-lis)
 250             (if (listp sub-lis)
 251                 (org-babel-ref-index-list remainder sub-lis)
 252               sub-lis))
 253           (if (or (= 0 (length portion)) (string-match ind-re portion))
 254               (mapcar
 255                (lambda (n) (nth n lis))
 256                (apply 'org-number-sequence
 257                       (if (and (> (length portion) 0) (match-string 2 portion))
 258                           (list
 259                            (funcall wrap (string-to-number (match-string 2 portion)))
 260                            (funcall wrap (string-to-number (match-string 3 portion))))
 261                         (list (funcall wrap 0) (funcall wrap -1)))))
 262             (list (nth (funcall wrap (string-to-number portion)) lis))))))
 263     lis))
 264
 265 (defun org-babel-ref-split-args (arg-string)
 266   "Split ARG-STRING into top-level arguments of balanced parenthesis."
 267   (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44)))
 268
 269 (defvar org-bracket-link-regexp)
 270 (defun org-babel-ref-at-ref-p ()
 271   "Return the type of reference located at point.
 272 Return nil if none of the supported reference types are found.
 273 Supported reference types are tables and source blocks."
 274   (cond ((org-at-table-p) 'table)
 275         ((org-at-item-p) 'list)
 276         ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block)
 277         ((looking-at org-bracket-link-regexp) 'file)
 278         ((looking-at org-babel-result-regexp) 'results-line)))
 279
 280 (provide 'ob-ref)
 281
 282
 283
 284 ;;; ob-ref.el ends here