| commit | author | age | ||
| 76bbd0 | 1 | ;;; ob-lob.el --- Functions Supporting the Library of Babel -*- 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 | ;;; Code: | |
| 26 | (require 'cl-lib) | |
| 27 | (require 'ob-core) | |
| 28 | (require 'ob-table) | |
| 29 | ||
| 30 | (declare-function org-babel-ref-split-args "ob-ref" (arg-string)) | |
| 31 | (declare-function org-element-at-point "org-element" ()) | |
| 32 | (declare-function org-element-context "org-element" (&optional element)) | |
| 33 | (declare-function org-element-property "org-element" (property element)) | |
| 34 | (declare-function org-element-type "org-element" (element)) | |
| 35 | ||
| 36 | (defvar org-babel-library-of-babel nil | |
| 37 | "Library of source-code blocks. | |
| 38 | This is an association list. Populate the library by calling | |
| 39 | `org-babel-lob-ingest' on files containing source blocks.") | |
| 40 | ||
| 41 | (defvar org-babel-default-lob-header-args '((:exports . "results")) | |
| 42 | "Default header arguments to use when exporting Babel calls. | |
| 43 | By default, a Babel call inherits its arguments from the source | |
| 44 | block being called. Header arguments defined in this variable | |
| 45 | take precedence over these. It is useful for properties that | |
| 46 | should not be inherited from a source block.") | |
| 47 | ||
| 48 | (defun org-babel-lob-ingest (&optional file) | |
| 49 | "Add all named source blocks defined in FILE to `org-babel-library-of-babel'." | |
| 50 | (interactive "fFile: ") | |
| 51 | (let ((lob-ingest-count 0)) | |
| 52 | (org-babel-map-src-blocks file | |
| 53 | (let* ((info (org-babel-get-src-block-info 'light)) | |
| 54 | (source-name (nth 4 info))) | |
| 55 | (when source-name | |
| 56 | (setf (nth 1 info) | |
| 57 | (if (org-babel-noweb-p (nth 2 info) :eval) | |
| 58 | (org-babel-expand-noweb-references info) | |
| 59 | (nth 1 info))) | |
| 60 | (let ((source (intern source-name))) | |
| 61 | (setq org-babel-library-of-babel | |
| 62 | (cons (cons source info) | |
| 63 | (assq-delete-all source org-babel-library-of-babel)))) | |
| 64 | (cl-incf lob-ingest-count)))) | |
| 65 | (message "%d src block%s added to Library of Babel" | |
| 66 | lob-ingest-count (if (> lob-ingest-count 1) "s" "")) | |
| 67 | lob-ingest-count)) | |
| 68 | ||
| 69 | ;; Functions for executing lob one-liners. | |
| 70 | ||
| 71 | ;;;###autoload | |
| 72 | (defun org-babel-lob-execute-maybe () | |
| 73 | "Execute a Library of Babel source block, if appropriate. | |
| 74 | Detect if this is context for a Library Of Babel source block and | |
| 75 | if so then run the appropriate source block from the Library." | |
| 76 | (interactive) | |
| 77 | (let ((info (org-babel-lob-get-info))) | |
| 78 | (when info | |
| 79 | (org-babel-execute-src-block nil info) | |
| 80 | t))) | |
| 81 | ||
| 82 | (defun org-babel-lob--src-info (ref) | |
| 83 | "Return internal representation for Babel data referenced as REF. | |
| 84 | REF is a string. This function looks into the current document | |
| 85 | for a Babel call or source block. If none is found, it looks | |
| 86 | after REF in the Library of Babel." | |
| 87 | (let ((name ref) | |
| 88 | (file nil)) | |
| 89 | ;; Extract the remote file, if specified in the reference. | |
| 90 | (when (string-match "\\`\\(.+\\):\\(.+\\)\\'" ref) | |
| 91 | (setq file (match-string 1 ref)) | |
| 92 | (setq name (match-string 2 ref))) | |
| 93 | ;; During export, look into the pristine copy of the document | |
| 94 | ;; being exported instead of the current one, which could miss | |
| 95 | ;; some data. | |
| 96 | (with-current-buffer (cond (file (find-file-noselect file t)) | |
| 97 | (org-babel-exp-reference-buffer) | |
| 98 | (t (current-buffer))) | |
| 99 | (org-with-point-at 1 | |
| 100 | (catch :found | |
| 101 | (let ((case-fold-search t) | |
| 102 | (regexp (org-babel-named-data-regexp-for-name name))) | |
| 103 | (while (re-search-forward regexp nil t) | |
| 104 | (let ((element (org-element-at-point))) | |
| 105 | (when (equal name (org-element-property :name element)) | |
| 106 | (throw :found | |
| 107 | (pcase (org-element-type element) | |
| 108 | (`src-block (org-babel-get-src-block-info t element)) | |
| 109 | (`babel-call (org-babel-lob-get-info element)) | |
| 110 | ;; Non-executable data found. Since names | |
| 111 | ;; are supposed to be unique throughout | |
| 112 | ;; a document, bail out. | |
| 113 | (_ nil)))))) | |
| 114 | (cdr (assoc-string ref org-babel-library-of-babel)))))))) | |
| 115 | ||
| 116 | ;;;###autoload | |
| 117 | (defun org-babel-lob-get-info (&optional datum) | |
| 118 | "Return internal representation for Library of Babel function call. | |
| 119 | ||
| 120 | Consider DATUM, when provided, or element at point otherwise. | |
| 121 | ||
| 122 | Return nil when not on an appropriate location. Otherwise return | |
| 123 | a list compatible with `org-babel-get-src-block-info', which | |
| 124 | see." | |
| 125 | (let* ((context (or datum (org-element-context))) | |
| 126 | (type (org-element-type context)) | |
| 127 | (reference (org-element-property :call context))) | |
| 128 | (when (memq type '(babel-call inline-babel-call)) | |
| 129 | (pcase (org-babel-lob--src-info reference) | |
| 130 | (`(,language ,body ,header ,_ ,_ ,_ ,coderef) | |
| 131 | (let ((begin (org-element-property (if (eq type 'inline-babel-call) | |
| 132 | :begin | |
| 133 | :post-affiliated) | |
| 134 | context))) | |
| 135 | (list language | |
| 136 | body | |
| 137 | (apply #'org-babel-merge-params | |
| 138 | header | |
| 139 | org-babel-default-lob-header-args | |
| 140 | (append | |
| 141 | (org-with-wide-buffer | |
| 142 | (goto-char begin) | |
| 143 | (org-babel-params-from-properties language)) | |
| 144 | (list | |
| 145 | (org-babel-parse-header-arguments | |
| 146 | (org-element-property :inside-header context)) | |
| 147 | (let ((args (org-element-property :arguments context))) | |
| 148 | (and args | |
| 149 | (mapcar (lambda (ref) (cons :var ref)) | |
| 150 | (org-babel-ref-split-args args)))) | |
| 151 | (org-babel-parse-header-arguments | |
| 152 | (org-element-property :end-header context))))) | |
| 153 | nil | |
| 154 | (org-element-property :name context) | |
| 155 | begin | |
| 156 | coderef))) | |
| 157 | (_ nil))))) | |
| 158 | ||
| 159 | (provide 'ob-lob) | |
| 160 | ||
| 161 | ;; Local variables: | |
| 162 | ;; generated-autoload-file: "org-loaddefs.el" | |
| 163 | ;; End: | |
| 164 | ||
| 165 | ;;; ob-lob.el ends here | |
