ob-tcl.el 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. ;;; ob-tcl.el --- Org-babel functions for tcl evaluation
  2. ;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
  3. ;; Authors: Dan Davison
  4. ;; Eric Schulte
  5. ;; Luis Anaya (tcl)
  6. ;;
  7. ;; Keywords: literate programming, reproducible research
  8. ;; Homepage: http://orgmode.org
  9. ;; This file is not part of GNU Emacs.
  10. ;; This program is free software: you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation, either version 3 of the License, or
  13. ;; (at your option) any later version.
  14. ;; This program is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  20. ;;; Commentary:
  21. ;; Org-Babel support for evaluating tcl source code.
  22. ;;; Code:
  23. (require 'ob)
  24. (require 'ob-eval)
  25. (eval-when-compile (require 'cl))
  26. (defvar org-babel-tangle-lang-exts)
  27. (add-to-list 'org-babel-tangle-lang-exts '("tcl" . "tcl"))
  28. (defvar org-babel-default-header-args:tcl nil)
  29. (defcustom org-babel-tcl-command "tclsh"
  30. "Name of command to use for executing Tcl code."
  31. :group 'org-babel
  32. :type 'string)
  33. (defun org-babel-execute:tcl (body params)
  34. "Execute a block of Tcl code with Babel.
  35. This function is called by `org-babel-execute-src-block'."
  36. (let* ((session (cdr (assq :session params)))
  37. (result-params (cdr (assq :result-params params)))
  38. (result-type (cdr (assq :result-type params)))
  39. (full-body (org-babel-expand-body:generic
  40. body params (org-babel-variable-assignments:tcl params)))
  41. (session (org-babel-tcl-initiate-session session)))
  42. (org-babel-reassemble-table
  43. (org-babel-tcl-evaluate session full-body result-type)
  44. (org-babel-pick-name
  45. (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
  46. (org-babel-pick-name
  47. (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
  48. (defun org-babel-prep-session:tcl (session params)
  49. "Prepare SESSION according to the header arguments in PARAMS."
  50. (error "Sessions are not supported for Tcl"))
  51. (defun org-babel-variable-assignments:tcl (params)
  52. "Return list of tcl statements assigning the block's variables."
  53. (mapcar
  54. (lambda (pair)
  55. (format "set %s %s"
  56. (car pair)
  57. (org-babel-tcl-var-to-tcl (cdr pair))))
  58. (org-babel--get-vars params)))
  59. ;; helper functions
  60. (defun org-babel-tcl-var-to-tcl (var)
  61. "Convert an elisp value to a tcl variable.
  62. The elisp value, VAR, is converted to a string of tcl source code
  63. specifying a var of the same value."
  64. (if (listp var)
  65. (concat "{" (mapconcat #'org-babel-tcl-var-to-tcl var " ") "}")
  66. (format "%s" var)))
  67. (defvar org-babel-tcl-buffers '(:default . nil))
  68. (defun org-babel-tcl-initiate-session (&optional session params)
  69. "Return nil because sessions are not supported by tcl."
  70. nil)
  71. (defvar org-babel-tcl-wrapper-method
  72. "
  73. proc main {} {
  74. %s
  75. }
  76. set r [eval main]
  77. set o [open \"%s\" \"w\"];
  78. puts $o $r
  79. flush $o
  80. close $o
  81. ")
  82. (defvar org-babel-tcl-pp-wrapper-method
  83. nil)
  84. (defun org-babel-tcl-evaluate (session body &optional result-type)
  85. "Pass BODY to the Tcl process in SESSION.
  86. If RESULT-TYPE equals 'output then return a list of the outputs
  87. of the statements in BODY, if RESULT-TYPE equals 'value then
  88. return the value of the last statement in BODY, as elisp."
  89. (when session (error "Sessions are not supported for Tcl"))
  90. (case result-type
  91. (output (org-babel-eval org-babel-tcl-command body))
  92. (value (let ((tmp-file (org-babel-temp-file "tcl-")))
  93. (org-babel-eval
  94. org-babel-tcl-command
  95. (format org-babel-tcl-wrapper-method body
  96. (org-babel-process-file-name tmp-file 'noquote)))
  97. (org-babel-eval-read-file tmp-file)))))
  98. (provide 'ob-tcl)
  99. ;;; ob-tcl.el ends here