ob-stata.el (11882B)
1 ;;; ob-stata.el --- org-babel functions for stata code evaluation 2 3 ;; Copyright (C) 2014, 2021 Ista Zahn 4 ;; Author: Ista Zahn istazahn@gmail.com 5 ;; G. Jay Kerns 6 ;; Eric Schulte 7 ;; Dan Davison 8 9 ;; This file is not part of GNU Emacs. 10 11 ;; This program is free software; you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation; either version 3, or (at your option) 14 ;; any later version. 15 ;; 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 ;; 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24 ;; Boston, MA 02110-1301, USA. 25 26 ;;; Commentary: 27 28 ;; The file provides Org-Babel support for evaluating stata code. 29 ;; It is basically result of find-and-replace "stata" for "julia" 30 ;; in ob-julia.el by G. Jay Kerns. Only ":results output" works: the 31 ;; header args must include ":results output" (this is the default). 32 ;; Note that I'm not sure ':results value' makes sense or is useful 33 ;; but I have left all the value-processing stuff inherited from 34 ;; ob-julia and ob-R. ':results graphics' would be nice, but I have 35 ;; not tried to implement it. 36 ;; --Ista, 07/30/2014 37 38 ;;; Requirements: 39 ;; Stata: https://stata.com 40 ;; ESS: https://ess.r-project.org 41 42 ;;; Code: 43 (require 'ob) 44 (require 'cl-lib) 45 46 (declare-function orgtbl-to-csv "org-table" (table params)) 47 (declare-function stata "ext:ess-stata" (&optional start-args)) 48 (declare-function inferior-ess-send-input "ext:ess-inf" ()) 49 (declare-function ess-make-buffer-current "ext:ess-inf" ()) 50 (declare-function ess-eval-buffer "ext:ess-inf" (vis)) 51 (declare-function org-number-sequence "org-compat" (from &optional to inc)) 52 53 (defconst org-babel-header-args:stata 54 '((width . :any) 55 (horizontal . :any) 56 (results . ((file list vector table scalar verbatim) 57 (raw org html latex code pp wrap) 58 (replace silent append prepend) 59 ;; NOTE: not sure 'value' makes sense in stata 60 ;; we may want to remove it from the list 61 (output value graphics)))) 62 "stata-specific header arguments.") 63 64 (add-to-list 'org-babel-tangle-lang-exts '("stata" . "do")) 65 66 ;; only ':results output' currently works, so make that the default 67 (defvar org-babel-default-header-args:stata '((:results . "output"))) 68 69 (defcustom org-babel-stata-command inferior-STA-program-name 70 "Name of command to use for executing stata code." 71 :group 'org-babel 72 :version "24.4" 73 :package-version '(Org . "8.3") 74 :type 'string) 75 76 (defvar ess-local-process-name) ; dynamically scoped 77 (defun org-babel-edit-prep:stata (info) 78 (let ((session (cdr (assq :session (nth 2 info))))) 79 (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) 80 (save-match-data (org-babel-stata-initiate-session session nil))))) 81 82 (defun org-babel-expand-body:stata (body params &optional graphics-file) 83 "Expand BODY according to PARAMS, return the expanded body." 84 (let ((graphics-file 85 (or graphics-file (org-babel-stata-graphical-output-file params)))) 86 (mapconcat 87 #'identity 88 ((lambda (inside) 89 (if graphics-file 90 inside 91 inside)) 92 (append (org-babel-variable-assignments:stata params) 93 (list body))) "\n"))) 94 95 (defun org-babel-execute:stata (body params) 96 "Execute a block of stata code. 97 This function is called by `org-babel-execute-src-block'." 98 (save-excursion 99 (let* ((result-params (cdr (assq :result-params params))) 100 (result-type (cdr (assq :result-type params))) 101 (session (org-babel-stata-initiate-session 102 (cdr (assq :session params)) params)) 103 (colnames-p (cdr (assq :colnames params))) 104 (rownames-p (cdr (assq :rownames params))) 105 (graphics-file (org-babel-stata-graphical-output-file params)) 106 (full-body (org-babel-expand-body:stata body params graphics-file)) 107 (result 108 (org-babel-stata-evaluate 109 session full-body result-type result-params 110 (or (equal "yes" colnames-p) 111 (org-babel-pick-name 112 (cdr (assq :colname-names params)) colnames-p)) 113 (or (equal "yes" rownames-p) 114 (org-babel-pick-name 115 (cdr (assq :rowname-names params)) rownames-p))))) 116 (if graphics-file nil result)))) 117 118 (defun org-babel-prep-session:stata (session params) 119 "Prepare SESSION according to the header arguments specified in PARAMS." 120 (let* ((session (org-babel-stata-initiate-session session params)) 121 (var-lines (org-babel-variable-assignments:stata params))) 122 (org-babel-comint-in-buffer session 123 (mapc (lambda (var) 124 (end-of-line 1) (insert var) (comint-send-input nil t) 125 (org-babel-comint-wait-for-output session)) var-lines)) 126 session)) 127 128 (defun org-babel-load-session:stata (session body params) 129 "Load BODY into SESSION." 130 (save-window-excursion 131 (let ((buffer (org-babel-prep-session:stata session params))) 132 (with-current-buffer buffer 133 (goto-char (process-mark (get-buffer-process (current-buffer)))) 134 (insert (org-babel-chomp body))) 135 buffer))) 136 137 ;; helper functions 138 139 (defun org-babel-variable-assignments:stata (params) 140 "Return list of stata statements assigning the block's variables." 141 (let ((vars (org-babel--get-vars params))) 142 (mapcar 143 (lambda (pair) 144 (org-babel-stata-assign-elisp 145 (car pair) (cdr pair) 146 (equal "yes" (cdr (assq :colnames params))) 147 (equal "yes" (cdr (assq :rownames params))))) 148 (mapcar 149 (lambda (i) 150 (cons (car (nth i vars)) 151 (org-babel-reassemble-table 152 (cdr (nth i vars)) 153 (cdr (nth i (cdr (assq :colname-names params)))) 154 (cdr (nth i (cdr (assq :rowname-names params))))))) 155 (org-number-sequence 0 (1- (length vars))))))) 156 157 (defun org-babel-stata-quote-csv-field (s) 158 "Quote field S for export to stata." 159 (if (stringp s) 160 (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") 161 (format "%S" s))) 162 163 (defun org-babel-stata-assign-elisp (name value colnames-p rownames-p) 164 "Construct stata code assigning the elisp VALUE to a variable named NAME." 165 (if (listp value) 166 (let ((max (apply #'max (mapcar #'length (cl-remove-if-not 167 #'sequencep value)))) 168 (min (apply #'min (mapcar #'length (cl-remove-if-not 169 #'sequencep value)))) 170 (transition-file (org-babel-temp-file "stata-import-"))) 171 ;; ensure VALUE has an orgtbl structure (depth of at least 2) 172 (unless (listp (car value)) (setq value (list value))) 173 (with-temp-file transition-file 174 (insert 175 (orgtbl-to-csv value '(:fmt org-babel-stata-quote-csv-field)) 176 "\n")) 177 (let ((file (org-babel-process-file-name transition-file 'noquote)) 178 (header (if (or (eq (nth 1 value) 'hline) colnames-p) 179 "TRUE" "FALSE")) 180 (row-names (if rownames-p "1" "NULL"))) 181 (if (= max min) 182 (format "%s = insheet using \"%s\"" name file) 183 (format "%s = insheet using \"%s\"" 184 name file)))) 185 (format "%s = %s" name (org-babel-stata-quote-csv-field value)))) 186 187 (defvar ess-ask-for-ess-directory) ; dynamically scoped 188 189 (defun org-babel-stata-initiate-session (session params) 190 "If there is not a current stata process then create one." 191 (unless (string= session "none") 192 (let ((session (or session "*stata*")) 193 (ess-ask-for-ess-directory 194 (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) 195 (not (cdr (assq :dir params)))))) 196 (if (org-babel-comint-buffer-livep session) 197 session 198 (save-window-excursion 199 (require 'ess) (stata) 200 (rename-buffer 201 (if (bufferp session) 202 (buffer-name session) 203 (if (stringp session) 204 session 205 (buffer-name)))) 206 (current-buffer)))))) 207 208 (defun org-babel-stata-associate-session (session) 209 "Associate stata code buffer with a stata session. 210 Make SESSION be the inferior ESS process associated with the 211 current code buffer." 212 (setq ess-local-process-name 213 (process-name (get-buffer-process session))) 214 (ess-make-buffer-current)) 215 216 (defun org-babel-stata-graphical-output-file (params) 217 "Name of file to which stata should send graphical output." 218 (and (member "graphics" (cdr (assq :result-params params))) 219 (cdr (assq :file params)))) 220 221 (defvar org-babel-stata-eoe-indicator "display \"org_babel_stata_eoe\"") 222 (defvar org-babel-stata-eoe-output "org_babel_stata_eoe") 223 224 (defvar org-babel-stata-write-object-command "outsheet using \"%s\"") 225 226 (defun org-babel-stata-evaluate 227 (session body result-type result-params column-names-p row-names-p) 228 "Evaluate stata code in BODY." 229 (if session 230 (org-babel-stata-evaluate-session 231 session body result-type result-params column-names-p row-names-p) 232 (org-babel-stata-evaluate-external-process 233 body result-type result-params column-names-p row-names-p))) 234 235 (defun org-babel-stata-evaluate-external-process 236 (body result-type result-params column-names-p row-names-p) 237 "Evaluate BODY in external stata process. 238 If RESULT-TYPE equals 'output then return standard output as a 239 string. If RESULT-TYPE equals 'value then return the value of the 240 last statement in BODY, as elisp." 241 (cl-case result-type 242 (value 243 (let ((tmp-file (org-babel-temp-file "stata-"))) 244 (org-babel-eval org-babel-stata-command 245 (format org-babel-stata-write-object-command 246 (org-babel-process-file-name tmp-file 'noquote) 247 (format "begin\n%s\nend" body))) 248 (org-babel-stata-process-value-result 249 (org-babel-result-cond result-params 250 (with-temp-buffer 251 (insert-file-contents tmp-file) 252 (buffer-string)) 253 (org-babel-import-elisp-from-file tmp-file '(4))) 254 column-names-p))) 255 (output (org-babel-eval org-babel-stata-command body)))) 256 257 (defun org-babel-stata-evaluate-session 258 (session body result-type result-params column-names-p row-names-p) 259 "Evaluate BODY in SESSION. 260 If RESULT-TYPE equals 'output then return standard output as a 261 string. If RESULT-TYPE equals 'value then return the value of the 262 last statement in BODY, as elisp." 263 (cl-case result-type 264 (value 265 (with-temp-buffer 266 (insert (org-babel-chomp body)) 267 (let ((ess-local-process-name 268 (process-name (get-buffer-process session))) 269 (ess-eval-visibly-p nil)) 270 (ess-eval-buffer nil))) 271 (let ((tmp-file (org-babel-temp-file "stata-"))) 272 (org-babel-comint-eval-invisibly-and-wait-for-file 273 session tmp-file 274 (format org-babel-stata-write-object-command 275 (org-babel-process-file-name tmp-file 'noquote) "ans")) 276 (org-babel-stata-process-value-result 277 (org-babel-result-cond result-params 278 (with-temp-buffer 279 (insert-file-contents tmp-file) 280 (buffer-string)) 281 (org-babel-import-elisp-from-file tmp-file '(4))) 282 column-names-p))) 283 (output 284 (mapconcat 285 #'org-babel-chomp 286 (butlast 287 (delq nil 288 (mapcar 289 (lambda (line) (when (> (length line) 0) line)) 290 (mapcar 291 (lambda (line) ;; cleanup extra prompts left in output 292 (if (string-match 293 "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) 294 (substring line (match-end 1)) 295 line)) 296 (org-babel-comint-with-output (session org-babel-stata-eoe-output) 297 (insert (mapconcat #'org-babel-chomp 298 (list body org-babel-stata-eoe-indicator) 299 "\n")) 300 (inferior-ess-send-input)))))) "\n")))) 301 302 (defun org-babel-stata-process-value-result (result column-names-p) 303 "stata-specific processing of return value. 304 Insert hline if column names in output have been requested." 305 (if column-names-p 306 (cons (car result) (cons 'hline (cdr result))) 307 result)) 308 309 (provide 'ob-stata) 310 311 ;;; ob-stata.el ends here