lisp/org/ob-ref.el

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