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