lisp/ob-lob.el

   1 ;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2009-2019 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 source 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-point-at begin
 142                            (org-babel-params-from-properties language))
 143                          (list
 144                           (org-babel-parse-header-arguments
 145                            (org-element-property :inside-header context))
 146                           (let ((args (org-element-property :arguments context)))
 147                             (and args
 148                                  (mapcar (lambda (ref) (cons :var ref))
 149                                          (org-babel-ref-split-args args))))
 150                           (org-babel-parse-header-arguments
 151                            (org-element-property :end-header context)))))
 152                  nil
 153                  (org-element-property :name context)
 154                  begin
 155                  coderef)))
 156         (_ nil)))))
 157
 158 (provide 'ob-lob)
 159
 160 ;; Local variables:
 161 ;; generated-autoload-file: "org-loaddefs.el"
 162 ;; End:
 163
 164 ;;; ob-lob.el ends here