ob-table.el 5.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. ;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
  3. ;; Author: Eric Schulte
  4. ;; Keywords: literate programming, reproducible research
  5. ;; Homepage: http://orgmode.org
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; Should allow calling functions from Org tables using the function
  19. ;; `org-sbe' as so...
  20. ;; #+begin_src emacs-lisp :results silent
  21. ;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
  22. ;; #+end_src
  23. ;; #+name: fibbd
  24. ;; #+begin_src emacs-lisp :var n=2 :results silent
  25. ;; (fibbd n)
  26. ;; #+end_src
  27. ;; | original | fibbd |
  28. ;; |----------+--------|
  29. ;; | 0 | |
  30. ;; | 1 | |
  31. ;; | 2 | |
  32. ;; | 3 | |
  33. ;; | 4 | |
  34. ;; | 5 | |
  35. ;; | 6 | |
  36. ;; | 7 | |
  37. ;; | 8 | |
  38. ;; | 9 | |
  39. ;; #+TBLFM: $2='(org-sbe "fibbd" (n $1))
  40. ;; NOTE: The quotation marks around the function name, 'fibbd' here,
  41. ;; are optional.
  42. ;;; Code:
  43. (require 'ob-core)
  44. (declare-function org-trim "org" (s &optional keep-lead))
  45. (defun org-babel-table-truncate-at-newline (string)
  46. "Replace newline character with ellipses.
  47. If STRING ends in a newline character, then remove the newline
  48. character and replace it with ellipses."
  49. (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string))
  50. (concat (substring string 0 (match-beginning 0))
  51. (when (match-string 1 string) "...")) string))
  52. (defmacro org-sbe (source-block &rest variables)
  53. "Return the results of calling SOURCE-BLOCK with VARIABLES.
  54. Each element of VARIABLES should be a list of two elements: the
  55. first element is the name of the variable and second element is a
  56. string of its value.
  57. So this `org-sbe' construct
  58. (org-sbe \"source-block\" (n $2) (m 3))
  59. is the equivalent of the following source code block:
  60. #+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
  61. results
  62. #+end_src
  63. NOTE: The quotation marks around the function name,
  64. 'source-block', are optional.
  65. NOTE: By default, string variable names are interpreted as
  66. references to source-code blocks, to force interpretation of a
  67. cell's value as a string, prefix the identifier a \"$\" (e.g.,
  68. \"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\").
  69. NOTE: It is also possible to pass header arguments to the code
  70. block. In this case a table cell should hold the string value of
  71. the header argument which can then be passed before all variables
  72. as shown in the example below.
  73. | 1 | 2 | :file nothing.png | nothing.png |
  74. #+TBLFM: @1$4=\\='(org-sbe test-sbe $3 (x $1) (y $2))"
  75. (declare (debug (form form)))
  76. (let* ((header-args (if (stringp (car variables)) (car variables) ""))
  77. (variables (if (stringp (car variables)) (cdr variables) variables)))
  78. (let* (quote
  79. (variables
  80. (mapcar
  81. (lambda (var)
  82. ;; ensure that all cells prefixed with $'s are strings
  83. (cons (car var)
  84. (delq nil (mapcar
  85. (lambda (el)
  86. (if (eq '$ el)
  87. (prog1 nil (setq quote t))
  88. (prog1
  89. (cond
  90. (quote (format "\"%s\"" el))
  91. ((stringp el) (org-no-properties el))
  92. (t el))
  93. (setq quote nil))))
  94. (cdr var)))))
  95. variables)))
  96. (unless (stringp source-block)
  97. (setq source-block (symbol-name source-block)))
  98. (let ((result
  99. (if (and source-block (> (length source-block) 0))
  100. (let ((params
  101. ;; FIXME: Why `eval'?!?!?
  102. (eval `(org-babel-parse-header-arguments
  103. (concat
  104. ":var results="
  105. ,source-block
  106. "[" ,header-args "]"
  107. "("
  108. (mapconcat
  109. (lambda (var-spec)
  110. (if (> (length (cdr var-spec)) 1)
  111. (format "%S='%S"
  112. (car var-spec)
  113. (mapcar #'read (cdr var-spec)))
  114. (format "%S=%s"
  115. (car var-spec) (cadr var-spec))))
  116. ',variables ", ")
  117. ")")))))
  118. (org-babel-execute-src-block
  119. nil (list "emacs-lisp" "results" params)
  120. '((:results . "silent"))))
  121. "")))
  122. (org-trim (if (stringp result) result (format "%S" result)))))))
  123. (provide 'ob-table)
  124. ;;; ob-table.el ends here