Commit | Line | Data |
---|---|---|
86fbb8ca CD |
1 | ;;; ob-screen.el --- org-babel support for interactive terminal |
2 | ||
3 | ;; Copyright (C) 2009, 2010 Free Software Foundation | |
4 | ||
5 | ;; Author: Benjamin Andresen | |
6 | ;; Keywords: literate programming, interactive shell | |
7 | ;; Homepage: http://orgmode.org | |
8 | ;; Version: 7.01 | |
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 <http://www.gnu.org/licenses/>. | |
24 | ||
25 | ;;; Commentary: | |
26 | ||
27 | ;; Org-Babel support for interactive terminals. Mostly shell scripts. | |
28 | ;; Heavily inspired by 'eev' from Eduardo Ochs | |
29 | ;; | |
30 | ;; Adding :cmd and :terminal as header arguments | |
31 | ;; :terminal must support the -T (title) and -e (command) parameter | |
32 | ;; | |
33 | ;; You can test the default setup. (xterm + sh) with | |
34 | ;; M-x org-babel-screen-test RET | |
35 | ||
36 | ;;; Code: | |
37 | (require 'ob) | |
38 | (require 'ob-ref) | |
39 | ||
40 | (defvar org-babel-screen-location "screen" | |
41 | "The command location for screen. | |
42 | In case you want to use a different screen than one selected by your $PATH") | |
43 | ||
44 | (defvar org-babel-default-header-args:screen | |
45 | '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) | |
46 | "Default arguments to use when running screen source blocks.") | |
47 | ||
48 | (defun org-babel-expand-body:screen (body params &optional processed-params) | |
49 | "Expand BODY according to PARAMS, return the expanded body." body) | |
50 | ||
51 | (defun org-babel-execute:screen (body params) | |
52 | "Send a block of code via screen to a terminal using Babel. | |
53 | \"default\" session is be used when none is specified." | |
54 | (message "Sending source code block to interactive terminal session...") | |
55 | (save-window-excursion | |
56 | (let* ((processed-params (org-babel-process-params params)) | |
57 | (session (nth 0 processed-params)) | |
58 | (socket (org-babel-screen-session-socketname session))) | |
59 | (unless socket (org-babel-prep-session:screen session params)) | |
60 | (org-babel-screen-session-execute-string | |
61 | session (org-babel-expand-body:screen body params))))) | |
62 | ||
63 | (defun org-babel-prep-session:screen (session params) | |
64 | "Prepare SESSION according to the header arguments specified in PARAMS." | |
65 | (let* ((processed-params (org-babel-process-params params)) | |
66 | (session (nth 0 processed-params)) | |
67 | (vars (nth 1 processed-params)) | |
68 | (socket (org-babel-screen-session-socketname session)) | |
69 | (vars (org-babel-ref-variables params)) | |
70 | (cmd (cdr (assoc :cmd params))) | |
71 | (terminal (cdr (assoc :terminal params))) | |
72 | (process-name (concat "org-babel: terminal (" session ")"))) | |
73 | (apply 'start-process process-name "*Messages*" | |
74 | terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location | |
75 | "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) | |
76 | ,cmd)) | |
77 | ;; XXX: Is there a better way than the following? | |
78 | (while (not (org-babel-screen-session-socketname session)) | |
79 | ;; wait until screen session is available before returning | |
80 | ))) | |
81 | ||
82 | ;; helper functions | |
83 | ||
84 | (defun org-babel-screen-session-execute-string (session body) | |
85 | "If SESSION exists, send BODY to it." | |
86 | (let ((socket (org-babel-screen-session-socketname session))) | |
87 | (when socket | |
88 | (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) | |
89 | (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" | |
90 | org-babel-screen-location | |
91 | `("-S" ,socket "-X" "eval" "msgwait 0" | |
92 | ,(concat "readreg z " tmpfile) | |
93 | "paste z")))))) | |
94 | ||
95 | (defun org-babel-screen-session-socketname (session) | |
96 | "Check if SESSION exists by parsing output of \"screen -ls\"." | |
97 | (let* ((screen-ls (shell-command-to-string "screen -ls")) | |
98 | (sockets (delq | |
99 | nil | |
100 | (mapcar | |
101 | (lambda (x) | |
102 | (when (string-match (rx (or "(Attached)" "(Detached)")) x) | |
103 | x)) | |
104 | (split-string screen-ls "\n")))) | |
105 | (match-socket (car | |
106 | (delq | |
107 | nil | |
108 | (mapcar | |
109 | (lambda (x) | |
110 | (when (string-match | |
111 | (concat "org-babel-session-" session) x) | |
112 | x)) | |
113 | sockets))))) | |
114 | (when match-socket (car (split-string match-socket))))) | |
115 | ||
116 | (defun org-babel-screen-session-write-temp-file (session body) | |
117 | "Save BODY in a temp file that is named after SESSION." | |
118 | (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) | |
119 | (with-temp-file tmpfile | |
120 | (insert body) | |
121 | ||
122 | ;; org-babel has superflous spaces | |
123 | (goto-char (point-min)) | |
124 | (delete-matching-lines "^ +$")) | |
125 | tmpfile)) | |
126 | ||
127 | (defun org-babel-screen-test () | |
128 | "Test if the default setup works. | |
129 | The terminal should shortly flicker." | |
130 | (interactive) | |
131 | (let* ((session "org-babel-testing") | |
132 | (random-string (format "%s" (random 99999))) | |
133 | (tmpfile "/tmp/org-babel-screen.test") | |
134 | (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) | |
135 | process tmp-string) | |
136 | (org-babel-execute:screen body org-babel-default-header-args:screen) | |
137 | ;; XXX: need to find a better way to do the following | |
138 | (while (not (file-readable-p tmpfile)) | |
139 | ;; do something, otherwise this will be optimized away | |
140 | (format "org-babel-screen: File not readable yet.")) | |
141 | (setq tmp-string (with-temp-buffer | |
142 | (insert-file-contents-literally tmpfile) | |
143 | (buffer-substring (point-min) (point-max)))) | |
144 | (delete-file tmpfile) | |
145 | (message (concat "org-babel-screen: Setup " | |
146 | (if (string-match random-string tmp-string) | |
147 | "WORKS." | |
148 | "DOESN'T work."))))) | |
149 | ||
150 | (provide 'ob-screen) | |
151 | ||
152 | ;; arch-tag: 908e5afe-89a0-4f27-b982-23f1f2e3bac9 | |
153 | ||
154 | ;;; ob-screen.el ends here |